LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
serrge.f
Go to the documentation of this file.
1*> \brief \b SERRGE
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8* Definition:
9* ===========
10*
11* SUBROUTINE SERRGE( PATH, NUNIT )
12*
13* .. Scalar Arguments ..
14* CHARACTER*3 PATH
15* INTEGER NUNIT
16* ..
17*
18*
19*> \par Purpose:
20* =============
21*>
22*> \verbatim
23*>
24*> SERRGE tests the error exits for the REAL routines
25*> for general matrices.
26*> \endverbatim
27*
28* Arguments:
29* ==========
30*
31*> \param[in] PATH
32*> \verbatim
33*> PATH is CHARACTER*3
34*> The LAPACK path name for the routines to be tested.
35*> \endverbatim
36*>
37*> \param[in] NUNIT
38*> \verbatim
39*> NUNIT is INTEGER
40*> The unit number for output.
41*> \endverbatim
42*
43* Authors:
44* ========
45*
46*> \author Univ. of Tennessee
47*> \author Univ. of California Berkeley
48*> \author Univ. of Colorado Denver
49*> \author NAG Ltd.
50*
51*> \ingroup single_lin
52*
53* =====================================================================
54 SUBROUTINE serrge( PATH, NUNIT )
55*
56* -- LAPACK test routine --
57* -- LAPACK is a software package provided by Univ. of Tennessee, --
58* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
59*
60* .. Scalar Arguments ..
61 CHARACTER*3 PATH
62 INTEGER NUNIT
63* ..
64*
65* =====================================================================
66*
67* .. Parameters ..
68 INTEGER NMAX, LW
69 parameter( nmax = 4, lw = 3*nmax )
70* ..
71* .. Local Scalars ..
72 CHARACTER*2 C2
73 INTEGER I, INFO, J
74 REAL ANRM, CCOND, RCOND
75* ..
76* .. Local Arrays ..
77 INTEGER IP( NMAX ), IW( NMAX )
78 REAL A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
79 $ R1( NMAX ), R2( NMAX ), W( LW ), X( NMAX )
80* ..
81* .. External Functions ..
82 LOGICAL LSAMEN
83 EXTERNAL lsamen
84* ..
85* .. External Subroutines ..
86 EXTERNAL alaesm, chkxer, sgbcon, sgbequ, sgbrfs, sgbtf2,
87 $ sgbtrf, sgbtrs, sgecon, sgeequ, sgerfs, sgetf2,
88 $ sgetrf, sgetri, sgetrs
89* ..
90* .. Scalars in Common ..
91 LOGICAL LERR, OK
92 CHARACTER*32 SRNAMT
93 INTEGER INFOT, NOUT
94* ..
95* .. Common blocks ..
96 COMMON / infoc / infot, nout, ok, lerr
97 COMMON / srnamc / srnamt
98* ..
99* .. Intrinsic Functions ..
100 INTRINSIC real
101* ..
102* .. Executable Statements ..
103*
104 nout = nunit
105 WRITE( nout, fmt = * )
106 c2 = path( 2: 3 )
107*
108* Set the variables to innocuous values.
109*
110 DO 20 j = 1, nmax
111 DO 10 i = 1, nmax
112 a( i, j ) = 1. / real( i+j )
113 af( i, j ) = 1. / real( i+j )
114 10 CONTINUE
115 b( j ) = 0.
116 r1( j ) = 0.
117 r2( j ) = 0.
118 w( j ) = 0.
119 x( j ) = 0.
120 ip( j ) = j
121 iw( j ) = j
122 20 CONTINUE
123 ok = .true.
124*
125 IF( lsamen( 2, c2, 'GE' ) ) THEN
126*
127* Test error exits of the routines that use the LU decomposition
128* of a general matrix.
129*
130* SGETRF
131*
132 srnamt = 'SGETRF'
133 infot = 1
134 CALL sgetrf( -1, 0, a, 1, ip, info )
135 CALL chkxer( 'SGETRF', infot, nout, lerr, ok )
136 infot = 2
137 CALL sgetrf( 0, -1, a, 1, ip, info )
138 CALL chkxer( 'SGETRF', infot, nout, lerr, ok )
139 infot = 4
140 CALL sgetrf( 2, 1, a, 1, ip, info )
141 CALL chkxer( 'SGETRF', infot, nout, lerr, ok )
142*
143* SGETF2
144*
145 srnamt = 'SGETF2'
146 infot = 1
147 CALL sgetf2( -1, 0, a, 1, ip, info )
148 CALL chkxer( 'SGETF2', infot, nout, lerr, ok )
149 infot = 2
150 CALL sgetf2( 0, -1, a, 1, ip, info )
151 CALL chkxer( 'SGETF2', infot, nout, lerr, ok )
152 infot = 4
153 CALL sgetf2( 2, 1, a, 1, ip, info )
154 CALL chkxer( 'SGETF2', infot, nout, lerr, ok )
155*
156* SGETRI
157*
158 srnamt = 'SGETRI'
159 infot = 1
160 CALL sgetri( -1, a, 1, ip, w, lw, info )
161 CALL chkxer( 'SGETRI', infot, nout, lerr, ok )
162 infot = 3
163 CALL sgetri( 2, a, 1, ip, w, lw, info )
164 CALL chkxer( 'SGETRI', infot, nout, lerr, ok )
165*
166* SGETRS
167*
168 srnamt = 'SGETRS'
169 infot = 1
170 CALL sgetrs( '/', 0, 0, a, 1, ip, b, 1, info )
171 CALL chkxer( 'SGETRS', infot, nout, lerr, ok )
172 infot = 2
173 CALL sgetrs( 'N', -1, 0, a, 1, ip, b, 1, info )
174 CALL chkxer( 'SGETRS', infot, nout, lerr, ok )
175 infot = 3
176 CALL sgetrs( 'N', 0, -1, a, 1, ip, b, 1, info )
177 CALL chkxer( 'SGETRS', infot, nout, lerr, ok )
178 infot = 5
179 CALL sgetrs( 'N', 2, 1, a, 1, ip, b, 2, info )
180 CALL chkxer( 'SGETRS', infot, nout, lerr, ok )
181 infot = 8
182 CALL sgetrs( 'N', 2, 1, a, 2, ip, b, 1, info )
183 CALL chkxer( 'SGETRS', infot, nout, lerr, ok )
184*
185* SGERFS
186*
187 srnamt = 'SGERFS'
188 infot = 1
189 CALL sgerfs( '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
190 $ iw, info )
191 CALL chkxer( 'SGERFS', infot, nout, lerr, ok )
192 infot = 2
193 CALL sgerfs( 'N', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
194 $ w, iw, info )
195 CALL chkxer( 'SGERFS', infot, nout, lerr, ok )
196 infot = 3
197 CALL sgerfs( 'N', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
198 $ w, iw, info )
199 CALL chkxer( 'SGERFS', infot, nout, lerr, ok )
200 infot = 5
201 CALL sgerfs( 'N', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
202 $ iw, info )
203 CALL chkxer( 'SGERFS', infot, nout, lerr, ok )
204 infot = 7
205 CALL sgerfs( 'N', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
206 $ iw, info )
207 CALL chkxer( 'SGERFS', infot, nout, lerr, ok )
208 infot = 10
209 CALL sgerfs( 'N', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
210 $ iw, info )
211 CALL chkxer( 'SGERFS', infot, nout, lerr, ok )
212 infot = 12
213 CALL sgerfs( 'N', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
214 $ iw, info )
215 CALL chkxer( 'SGERFS', infot, nout, lerr, ok )
216*
217* SGECON
218*
219 srnamt = 'SGECON'
220 infot = 1
221 CALL sgecon( '/', 0, a, 1, anrm, rcond, w, iw, info )
222 CALL chkxer( 'SGECON', infot, nout, lerr, ok )
223 infot = 2
224 CALL sgecon( '1', -1, a, 1, anrm, rcond, w, iw, info )
225 CALL chkxer( 'SGECON', infot, nout, lerr, ok )
226 infot = 4
227 CALL sgecon( '1', 2, a, 1, anrm, rcond, w, iw, info )
228 CALL chkxer( 'SGECON', infot, nout, lerr, ok )
229*
230* SGEEQU
231*
232 srnamt = 'SGEEQU'
233 infot = 1
234 CALL sgeequ( -1, 0, a, 1, r1, r2, rcond, ccond, anrm, info )
235 CALL chkxer( 'SGEEQU', infot, nout, lerr, ok )
236 infot = 2
237 CALL sgeequ( 0, -1, a, 1, r1, r2, rcond, ccond, anrm, info )
238 CALL chkxer( 'SGEEQU', infot, nout, lerr, ok )
239 infot = 4
240 CALL sgeequ( 2, 2, a, 1, r1, r2, rcond, ccond, anrm, info )
241 CALL chkxer( 'SGEEQU', infot, nout, lerr, ok )
242*
243 ELSE IF( lsamen( 2, c2, 'GB' ) ) THEN
244*
245* Test error exits of the routines that use the LU decomposition
246* of a general band matrix.
247*
248* SGBTRF
249*
250 srnamt = 'SGBTRF'
251 infot = 1
252 CALL sgbtrf( -1, 0, 0, 0, a, 1, ip, info )
253 CALL chkxer( 'SGBTRF', infot, nout, lerr, ok )
254 infot = 2
255 CALL sgbtrf( 0, -1, 0, 0, a, 1, ip, info )
256 CALL chkxer( 'SGBTRF', infot, nout, lerr, ok )
257 infot = 3
258 CALL sgbtrf( 1, 1, -1, 0, a, 1, ip, info )
259 CALL chkxer( 'SGBTRF', infot, nout, lerr, ok )
260 infot = 4
261 CALL sgbtrf( 1, 1, 0, -1, a, 1, ip, info )
262 CALL chkxer( 'SGBTRF', infot, nout, lerr, ok )
263 infot = 6
264 CALL sgbtrf( 2, 2, 1, 1, a, 3, ip, info )
265 CALL chkxer( 'SGBTRF', infot, nout, lerr, ok )
266*
267* SGBTF2
268*
269 srnamt = 'SGBTF2'
270 infot = 1
271 CALL sgbtf2( -1, 0, 0, 0, a, 1, ip, info )
272 CALL chkxer( 'SGBTF2', infot, nout, lerr, ok )
273 infot = 2
274 CALL sgbtf2( 0, -1, 0, 0, a, 1, ip, info )
275 CALL chkxer( 'SGBTF2', infot, nout, lerr, ok )
276 infot = 3
277 CALL sgbtf2( 1, 1, -1, 0, a, 1, ip, info )
278 CALL chkxer( 'SGBTF2', infot, nout, lerr, ok )
279 infot = 4
280 CALL sgbtf2( 1, 1, 0, -1, a, 1, ip, info )
281 CALL chkxer( 'SGBTF2', infot, nout, lerr, ok )
282 infot = 6
283 CALL sgbtf2( 2, 2, 1, 1, a, 3, ip, info )
284 CALL chkxer( 'SGBTF2', infot, nout, lerr, ok )
285*
286* SGBTRS
287*
288 srnamt = 'SGBTRS'
289 infot = 1
290 CALL sgbtrs( '/', 0, 0, 0, 1, a, 1, ip, b, 1, info )
291 CALL chkxer( 'SGBTRS', infot, nout, lerr, ok )
292 infot = 2
293 CALL sgbtrs( 'N', -1, 0, 0, 1, a, 1, ip, b, 1, info )
294 CALL chkxer( 'SGBTRS', infot, nout, lerr, ok )
295 infot = 3
296 CALL sgbtrs( 'N', 1, -1, 0, 1, a, 1, ip, b, 1, info )
297 CALL chkxer( 'SGBTRS', infot, nout, lerr, ok )
298 infot = 4
299 CALL sgbtrs( 'N', 1, 0, -1, 1, a, 1, ip, b, 1, info )
300 CALL chkxer( 'SGBTRS', infot, nout, lerr, ok )
301 infot = 5
302 CALL sgbtrs( 'N', 1, 0, 0, -1, a, 1, ip, b, 1, info )
303 CALL chkxer( 'SGBTRS', infot, nout, lerr, ok )
304 infot = 7
305 CALL sgbtrs( 'N', 2, 1, 1, 1, a, 3, ip, b, 2, info )
306 CALL chkxer( 'SGBTRS', infot, nout, lerr, ok )
307 infot = 10
308 CALL sgbtrs( 'N', 2, 0, 0, 1, a, 1, ip, b, 1, info )
309 CALL chkxer( 'SGBTRS', infot, nout, lerr, ok )
310*
311* SGBRFS
312*
313 srnamt = 'SGBRFS'
314 infot = 1
315 CALL sgbrfs( '/', 0, 0, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
316 $ r2, w, iw, info )
317 CALL chkxer( 'SGBRFS', infot, nout, lerr, ok )
318 infot = 2
319 CALL sgbrfs( 'N', -1, 0, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
320 $ r2, w, iw, info )
321 CALL chkxer( 'SGBRFS', infot, nout, lerr, ok )
322 infot = 3
323 CALL sgbrfs( 'N', 1, -1, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
324 $ r2, w, iw, info )
325 CALL chkxer( 'SGBRFS', infot, nout, lerr, ok )
326 infot = 4
327 CALL sgbrfs( 'N', 1, 0, -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
328 $ r2, w, iw, info )
329 CALL chkxer( 'SGBRFS', infot, nout, lerr, ok )
330 infot = 5
331 CALL sgbrfs( 'N', 1, 0, 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1,
332 $ r2, w, iw, info )
333 CALL chkxer( 'SGBRFS', infot, nout, lerr, ok )
334 infot = 7
335 CALL sgbrfs( 'N', 2, 1, 1, 1, a, 2, af, 4, ip, b, 2, x, 2, r1,
336 $ r2, w, iw, info )
337 CALL chkxer( 'SGBRFS', infot, nout, lerr, ok )
338 infot = 9
339 CALL sgbrfs( 'N', 2, 1, 1, 1, a, 3, af, 3, ip, b, 2, x, 2, r1,
340 $ r2, w, iw, info )
341 CALL chkxer( 'SGBRFS', infot, nout, lerr, ok )
342 infot = 12
343 CALL sgbrfs( 'N', 2, 0, 0, 1, a, 1, af, 1, ip, b, 1, x, 2, r1,
344 $ r2, w, iw, info )
345 CALL chkxer( 'SGBRFS', infot, nout, lerr, ok )
346 infot = 14
347 CALL sgbrfs( 'N', 2, 0, 0, 1, a, 1, af, 1, ip, b, 2, x, 1, r1,
348 $ r2, w, iw, info )
349 CALL chkxer( 'SGBRFS', infot, nout, lerr, ok )
350*
351* SGBCON
352*
353 srnamt = 'SGBCON'
354 infot = 1
355 CALL sgbcon( '/', 0, 0, 0, a, 1, ip, anrm, rcond, w, iw, info )
356 CALL chkxer( 'SGBCON', infot, nout, lerr, ok )
357 infot = 2
358 CALL sgbcon( '1', -1, 0, 0, a, 1, ip, anrm, rcond, w, iw,
359 $ info )
360 CALL chkxer( 'SGBCON', infot, nout, lerr, ok )
361 infot = 3
362 CALL sgbcon( '1', 1, -1, 0, a, 1, ip, anrm, rcond, w, iw,
363 $ info )
364 CALL chkxer( 'SGBCON', infot, nout, lerr, ok )
365 infot = 4
366 CALL sgbcon( '1', 1, 0, -1, a, 1, ip, anrm, rcond, w, iw,
367 $ info )
368 CALL chkxer( 'SGBCON', infot, nout, lerr, ok )
369 infot = 6
370 CALL sgbcon( '1', 2, 1, 1, a, 3, ip, anrm, rcond, w, iw, info )
371 CALL chkxer( 'SGBCON', infot, nout, lerr, ok )
372*
373* SGBEQU
374*
375 srnamt = 'SGBEQU'
376 infot = 1
377 CALL sgbequ( -1, 0, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
378 $ info )
379 CALL chkxer( 'SGBEQU', infot, nout, lerr, ok )
380 infot = 2
381 CALL sgbequ( 0, -1, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
382 $ info )
383 CALL chkxer( 'SGBEQU', infot, nout, lerr, ok )
384 infot = 3
385 CALL sgbequ( 1, 1, -1, 0, a, 1, r1, r2, rcond, ccond, anrm,
386 $ info )
387 CALL chkxer( 'SGBEQU', infot, nout, lerr, ok )
388 infot = 4
389 CALL sgbequ( 1, 1, 0, -1, a, 1, r1, r2, rcond, ccond, anrm,
390 $ info )
391 CALL chkxer( 'SGBEQU', infot, nout, lerr, ok )
392 infot = 6
393 CALL sgbequ( 2, 2, 1, 1, a, 2, r1, r2, rcond, ccond, anrm,
394 $ info )
395 CALL chkxer( 'SGBEQU', infot, nout, lerr, ok )
396 END IF
397*
398* Print a summary line.
399*
400 CALL alaesm( path, ok, nout )
401*
402 RETURN
403*
404* End of SERRGE
405*
406 END
alaesm
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
sgbcon
subroutine sgbcon(norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond, work, iwork, info)
SGBCON
Definition sgbcon.f:144
sgbequ
subroutine sgbequ(m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd, amax, info)
SGBEQU
Definition sgbequ.f:152
sgbrfs
subroutine sgbrfs(trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork, info)
SGBRFS
Definition sgbrfs.f:204
sgbtf2
subroutine sgbtf2(m, n, kl, ku, ab, ldab, ipiv, info)
SGBTF2 computes the LU factorization of a general band matrix using the unblocked version of the algo...
Definition sgbtf2.f:143
sgbtrf
subroutine sgbtrf(m, n, kl, ku, ab, ldab, ipiv, info)
SGBTRF
Definition sgbtrf.f:142
sgbtrs
subroutine sgbtrs(trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info)
SGBTRS
Definition sgbtrs.f:137
sgecon
subroutine sgecon(norm, n, a, lda, anorm, rcond, work, iwork, info)
SGECON
Definition sgecon.f:130
sgeequ
subroutine sgeequ(m, n, a, lda, r, c, rowcnd, colcnd, amax, info)
SGEEQU
Definition sgeequ.f:137
sgerfs
subroutine sgerfs(trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork, info)
SGERFS
Definition sgerfs.f:184
sgetf2
subroutine sgetf2(m, n, a, lda, ipiv, info)
SGETF2 computes the LU factorization of a general m-by-n matrix using partial pivoting with row inter...
Definition sgetf2.f:106
sgetrf
subroutine sgetrf(m, n, a, lda, ipiv, info)
SGETRF
Definition sgetrf.f:106
sgetri
subroutine sgetri(n, a, lda, ipiv, work, lwork, info)
SGETRI
Definition sgetri.f:112
sgetrs
subroutine sgetrs(trans, n, nrhs, a, lda, ipiv, b, ldb, info)
SGETRS
Definition sgetrs.f:119
serrge
subroutine serrge(path, nunit)
SERRGE
Definition serrge.f:55