LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ serrge()

subroutine serrge ( character*3  path,
integer  nunit 
)

SERRGE

Purpose:
 SERRGE tests the error exits for the REAL routines
 for general matrices.
Parameters
[in]PATH
          PATH is CHARACTER*3
          The LAPACK path name for the routines to be tested.
[in]NUNIT
          NUNIT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 54 of file serrge.f.

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*
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:146
sgbequ
subroutine sgbequ(m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd, amax, info)
SGBEQU
Definition sgbequ.f:153
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:205
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:145
sgbtrf
subroutine sgbtrf(m, n, kl, ku, ab, ldab, ipiv, info)
SGBTRF
Definition sgbtrf.f:144
sgbtrs
subroutine sgbtrs(trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info)
SGBTRS
Definition sgbtrs.f:138
sgecon
subroutine sgecon(norm, n, a, lda, anorm, rcond, work, iwork, info)
SGECON
Definition sgecon.f:132
sgeequ
subroutine sgeequ(m, n, a, lda, r, c, rowcnd, colcnd, amax, info)
SGEEQU
Definition sgeequ.f:139
sgerfs
subroutine sgerfs(trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork, info)
SGERFS
Definition sgerfs.f:185
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:108
sgetrf
subroutine sgetrf(m, n, a, lda, ipiv, info)
SGETRF
Definition sgetrf.f:108
sgetri
subroutine sgetri(n, a, lda, ipiv, work, lwork, info)
SGETRI
Definition sgetri.f:114
sgetrs
subroutine sgetrs(trans, n, nrhs, a, lda, ipiv, b, ldb, info)
SGETRS
Definition sgetrs.f:121
lsamen
logical function lsamen(n, ca, cb)
LSAMEN
Definition lsamen.f:74
Here is the call graph for this function:
Here is the caller graph for this function: