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

◆ cerrge()

subroutine cerrge ( character*3  path,
integer  nunit 
)

CERRGE

Purpose:
 CERRGE tests the error exits for the COMPLEX 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 cerrge.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
69 parameter( nmax = 4 )
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 )
78 REAL R( NMAX ), R1( NMAX ), R2( NMAX )
79 COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
80 $ W( 2*NMAX ), X( NMAX )
81* ..
82* .. External Functions ..
83 LOGICAL LSAMEN
84 EXTERNAL lsamen
85* ..
86* .. External Subroutines ..
87 EXTERNAL alaesm, cgbcon, cgbequ, cgbrfs, cgbtf2, cgbtrf,
90* ..
91* .. Scalars in Common ..
92 LOGICAL LERR, OK
93 CHARACTER*32 SRNAMT
94 INTEGER INFOT, NOUT
95* ..
96* .. Common blocks ..
97 COMMON / infoc / infot, nout, ok, lerr
98 COMMON / srnamc / srnamt
99* ..
100* .. Intrinsic Functions ..
101 INTRINSIC cmplx, real
102* ..
103* .. Executable Statements ..
104*
105 nout = nunit
106 WRITE( nout, fmt = * )
107 c2 = path( 2: 3 )
108*
109* Set the variables to innocuous values.
110*
111 DO 20 j = 1, nmax
112 DO 10 i = 1, nmax
113 a( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
114 af( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
115 10 CONTINUE
116 b( j ) = 0.
117 r1( j ) = 0.
118 r2( j ) = 0.
119 w( j ) = 0.
120 x( j ) = 0.
121 ip( j ) = j
122 20 CONTINUE
123 ok = .true.
124*
125* Test error exits of the routines that use the LU decomposition
126* of a general matrix.
127*
128 IF( lsamen( 2, c2, 'GE' ) ) THEN
129*
130* CGETRF
131*
132 srnamt = 'CGETRF'
133 infot = 1
134 CALL cgetrf( -1, 0, a, 1, ip, info )
135 CALL chkxer( 'CGETRF', infot, nout, lerr, ok )
136 infot = 2
137 CALL cgetrf( 0, -1, a, 1, ip, info )
138 CALL chkxer( 'CGETRF', infot, nout, lerr, ok )
139 infot = 4
140 CALL cgetrf( 2, 1, a, 1, ip, info )
141 CALL chkxer( 'CGETRF', infot, nout, lerr, ok )
142*
143* CGETF2
144*
145 srnamt = 'CGETF2'
146 infot = 1
147 CALL cgetf2( -1, 0, a, 1, ip, info )
148 CALL chkxer( 'CGETF2', infot, nout, lerr, ok )
149 infot = 2
150 CALL cgetf2( 0, -1, a, 1, ip, info )
151 CALL chkxer( 'CGETF2', infot, nout, lerr, ok )
152 infot = 4
153 CALL cgetf2( 2, 1, a, 1, ip, info )
154 CALL chkxer( 'CGETF2', infot, nout, lerr, ok )
155*
156* CGETRI
157*
158 srnamt = 'CGETRI'
159 infot = 1
160 CALL cgetri( -1, a, 1, ip, w, 1, info )
161 CALL chkxer( 'CGETRI', infot, nout, lerr, ok )
162 infot = 3
163 CALL cgetri( 2, a, 1, ip, w, 2, info )
164 CALL chkxer( 'CGETRI', infot, nout, lerr, ok )
165 infot = 6
166 CALL cgetri( 2, a, 2, ip, w, 1, info )
167 CALL chkxer( 'CGETRI', infot, nout, lerr, ok )
168*
169* CGETRS
170*
171 srnamt = 'CGETRS'
172 infot = 1
173 CALL cgetrs( '/', 0, 0, a, 1, ip, b, 1, info )
174 CALL chkxer( 'CGETRS', infot, nout, lerr, ok )
175 infot = 2
176 CALL cgetrs( 'N', -1, 0, a, 1, ip, b, 1, info )
177 CALL chkxer( 'CGETRS', infot, nout, lerr, ok )
178 infot = 3
179 CALL cgetrs( 'N', 0, -1, a, 1, ip, b, 1, info )
180 CALL chkxer( 'CGETRS', infot, nout, lerr, ok )
181 infot = 5
182 CALL cgetrs( 'N', 2, 1, a, 1, ip, b, 2, info )
183 CALL chkxer( 'CGETRS', infot, nout, lerr, ok )
184 infot = 8
185 CALL cgetrs( 'N', 2, 1, a, 2, ip, b, 1, info )
186 CALL chkxer( 'CGETRS', infot, nout, lerr, ok )
187*
188* CGERFS
189*
190 srnamt = 'CGERFS'
191 infot = 1
192 CALL cgerfs( '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
193 $ r, info )
194 CALL chkxer( 'CGERFS', infot, nout, lerr, ok )
195 infot = 2
196 CALL cgerfs( 'N', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
197 $ w, r, info )
198 CALL chkxer( 'CGERFS', infot, nout, lerr, ok )
199 infot = 3
200 CALL cgerfs( 'N', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
201 $ w, r, info )
202 CALL chkxer( 'CGERFS', infot, nout, lerr, ok )
203 infot = 5
204 CALL cgerfs( 'N', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
205 $ r, info )
206 CALL chkxer( 'CGERFS', infot, nout, lerr, ok )
207 infot = 7
208 CALL cgerfs( 'N', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
209 $ r, info )
210 CALL chkxer( 'CGERFS', infot, nout, lerr, ok )
211 infot = 10
212 CALL cgerfs( 'N', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
213 $ r, info )
214 CALL chkxer( 'CGERFS', infot, nout, lerr, ok )
215 infot = 12
216 CALL cgerfs( 'N', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
217 $ r, info )
218 CALL chkxer( 'CGERFS', infot, nout, lerr, ok )
219*
220* CGECON
221*
222 srnamt = 'CGECON'
223 infot = 1
224 CALL cgecon( '/', 0, a, 1, anrm, rcond, w, r, info )
225 CALL chkxer( 'CGECON', infot, nout, lerr, ok )
226 infot = 2
227 CALL cgecon( '1', -1, a, 1, anrm, rcond, w, r, info )
228 CALL chkxer( 'CGECON', infot, nout, lerr, ok )
229 infot = 4
230 CALL cgecon( '1', 2, a, 1, anrm, rcond, w, r, info )
231 CALL chkxer( 'CGECON', infot, nout, lerr, ok )
232*
233* CGEEQU
234*
235 srnamt = 'CGEEQU'
236 infot = 1
237 CALL cgeequ( -1, 0, a, 1, r1, r2, rcond, ccond, anrm, info )
238 CALL chkxer( 'CGEEQU', infot, nout, lerr, ok )
239 infot = 2
240 CALL cgeequ( 0, -1, a, 1, r1, r2, rcond, ccond, anrm, info )
241 CALL chkxer( 'CGEEQU', infot, nout, lerr, ok )
242 infot = 4
243 CALL cgeequ( 2, 2, a, 1, r1, r2, rcond, ccond, anrm, info )
244 CALL chkxer( 'CGEEQU', infot, nout, lerr, ok )
245*
246* Test error exits of the routines that use the LU decomposition
247* of a general band matrix.
248*
249 ELSE IF( lsamen( 2, c2, 'GB' ) ) THEN
250*
251* CGBTRF
252*
253 srnamt = 'CGBTRF'
254 infot = 1
255 CALL cgbtrf( -1, 0, 0, 0, a, 1, ip, info )
256 CALL chkxer( 'CGBTRF', infot, nout, lerr, ok )
257 infot = 2
258 CALL cgbtrf( 0, -1, 0, 0, a, 1, ip, info )
259 CALL chkxer( 'CGBTRF', infot, nout, lerr, ok )
260 infot = 3
261 CALL cgbtrf( 1, 1, -1, 0, a, 1, ip, info )
262 CALL chkxer( 'CGBTRF', infot, nout, lerr, ok )
263 infot = 4
264 CALL cgbtrf( 1, 1, 0, -1, a, 1, ip, info )
265 CALL chkxer( 'CGBTRF', infot, nout, lerr, ok )
266 infot = 6
267 CALL cgbtrf( 2, 2, 1, 1, a, 3, ip, info )
268 CALL chkxer( 'CGBTRF', infot, nout, lerr, ok )
269*
270* CGBTF2
271*
272 srnamt = 'CGBTF2'
273 infot = 1
274 CALL cgbtf2( -1, 0, 0, 0, a, 1, ip, info )
275 CALL chkxer( 'CGBTF2', infot, nout, lerr, ok )
276 infot = 2
277 CALL cgbtf2( 0, -1, 0, 0, a, 1, ip, info )
278 CALL chkxer( 'CGBTF2', infot, nout, lerr, ok )
279 infot = 3
280 CALL cgbtf2( 1, 1, -1, 0, a, 1, ip, info )
281 CALL chkxer( 'CGBTF2', infot, nout, lerr, ok )
282 infot = 4
283 CALL cgbtf2( 1, 1, 0, -1, a, 1, ip, info )
284 CALL chkxer( 'CGBTF2', infot, nout, lerr, ok )
285 infot = 6
286 CALL cgbtf2( 2, 2, 1, 1, a, 3, ip, info )
287 CALL chkxer( 'CGBTF2', infot, nout, lerr, ok )
288*
289* CGBTRS
290*
291 srnamt = 'CGBTRS'
292 infot = 1
293 CALL cgbtrs( '/', 0, 0, 0, 1, a, 1, ip, b, 1, info )
294 CALL chkxer( 'CGBTRS', infot, nout, lerr, ok )
295 infot = 2
296 CALL cgbtrs( 'N', -1, 0, 0, 1, a, 1, ip, b, 1, info )
297 CALL chkxer( 'CGBTRS', infot, nout, lerr, ok )
298 infot = 3
299 CALL cgbtrs( 'N', 1, -1, 0, 1, a, 1, ip, b, 1, info )
300 CALL chkxer( 'CGBTRS', infot, nout, lerr, ok )
301 infot = 4
302 CALL cgbtrs( 'N', 1, 0, -1, 1, a, 1, ip, b, 1, info )
303 CALL chkxer( 'CGBTRS', infot, nout, lerr, ok )
304 infot = 5
305 CALL cgbtrs( 'N', 1, 0, 0, -1, a, 1, ip, b, 1, info )
306 CALL chkxer( 'CGBTRS', infot, nout, lerr, ok )
307 infot = 7
308 CALL cgbtrs( 'N', 2, 1, 1, 1, a, 3, ip, b, 2, info )
309 CALL chkxer( 'CGBTRS', infot, nout, lerr, ok )
310 infot = 10
311 CALL cgbtrs( 'N', 2, 0, 0, 1, a, 1, ip, b, 1, info )
312 CALL chkxer( 'CGBTRS', infot, nout, lerr, ok )
313*
314* CGBRFS
315*
316 srnamt = 'CGBRFS'
317 infot = 1
318 CALL cgbrfs( '/', 0, 0, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
319 $ r2, w, r, info )
320 CALL chkxer( 'CGBRFS', infot, nout, lerr, ok )
321 infot = 2
322 CALL cgbrfs( 'N', -1, 0, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
323 $ r2, w, r, info )
324 CALL chkxer( 'CGBRFS', infot, nout, lerr, ok )
325 infot = 3
326 CALL cgbrfs( 'N', 1, -1, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
327 $ r2, w, r, info )
328 CALL chkxer( 'CGBRFS', infot, nout, lerr, ok )
329 infot = 4
330 CALL cgbrfs( 'N', 1, 0, -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
331 $ r2, w, r, info )
332 CALL chkxer( 'CGBRFS', infot, nout, lerr, ok )
333 infot = 5
334 CALL cgbrfs( 'N', 1, 0, 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1,
335 $ r2, w, r, info )
336 CALL chkxer( 'CGBRFS', infot, nout, lerr, ok )
337 infot = 7
338 CALL cgbrfs( 'N', 2, 1, 1, 1, a, 2, af, 4, ip, b, 2, x, 2, r1,
339 $ r2, w, r, info )
340 CALL chkxer( 'CGBRFS', infot, nout, lerr, ok )
341 infot = 9
342 CALL cgbrfs( 'N', 2, 1, 1, 1, a, 3, af, 3, ip, b, 2, x, 2, r1,
343 $ r2, w, r, info )
344 CALL chkxer( 'CGBRFS', infot, nout, lerr, ok )
345 infot = 12
346 CALL cgbrfs( 'N', 2, 0, 0, 1, a, 1, af, 1, ip, b, 1, x, 2, r1,
347 $ r2, w, r, info )
348 CALL chkxer( 'CGBRFS', infot, nout, lerr, ok )
349 infot = 14
350 CALL cgbrfs( 'N', 2, 0, 0, 1, a, 1, af, 1, ip, b, 2, x, 1, r1,
351 $ r2, w, r, info )
352 CALL chkxer( 'CGBRFS', infot, nout, lerr, ok )
353*
354* CGBCON
355*
356 srnamt = 'CGBCON'
357 infot = 1
358 CALL cgbcon( '/', 0, 0, 0, a, 1, ip, anrm, rcond, w, r, info )
359 CALL chkxer( 'CGBCON', infot, nout, lerr, ok )
360 infot = 2
361 CALL cgbcon( '1', -1, 0, 0, a, 1, ip, anrm, rcond, w, r, info )
362 CALL chkxer( 'CGBCON', infot, nout, lerr, ok )
363 infot = 3
364 CALL cgbcon( '1', 1, -1, 0, a, 1, ip, anrm, rcond, w, r, info )
365 CALL chkxer( 'CGBCON', infot, nout, lerr, ok )
366 infot = 4
367 CALL cgbcon( '1', 1, 0, -1, a, 1, ip, anrm, rcond, w, r, info )
368 CALL chkxer( 'CGBCON', infot, nout, lerr, ok )
369 infot = 6
370 CALL cgbcon( '1', 2, 1, 1, a, 3, ip, anrm, rcond, w, r, info )
371 CALL chkxer( 'CGBCON', infot, nout, lerr, ok )
372*
373* CGBEQU
374*
375 srnamt = 'CGBEQU'
376 infot = 1
377 CALL cgbequ( -1, 0, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
378 $ info )
379 CALL chkxer( 'CGBEQU', infot, nout, lerr, ok )
380 infot = 2
381 CALL cgbequ( 0, -1, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
382 $ info )
383 CALL chkxer( 'CGBEQU', infot, nout, lerr, ok )
384 infot = 3
385 CALL cgbequ( 1, 1, -1, 0, a, 1, r1, r2, rcond, ccond, anrm,
386 $ info )
387 CALL chkxer( 'CGBEQU', infot, nout, lerr, ok )
388 infot = 4
389 CALL cgbequ( 1, 1, 0, -1, a, 1, r1, r2, rcond, ccond, anrm,
390 $ info )
391 CALL chkxer( 'CGBEQU', infot, nout, lerr, ok )
392 infot = 6
393 CALL cgbequ( 2, 2, 1, 1, a, 2, r1, r2, rcond, ccond, anrm,
394 $ info )
395 CALL chkxer( 'CGBEQU', 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 CERRGE
405*
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
subroutine cgbcon(norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond, work, rwork, info)
CGBCON
Definition cgbcon.f:147
subroutine cgbequ(m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd, amax, info)
CGBEQU
Definition cgbequ.f:154
subroutine cgbrfs(trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork, info)
CGBRFS
Definition cgbrfs.f:206
subroutine cgbtf2(m, n, kl, ku, ab, ldab, ipiv, info)
CGBTF2 computes the LU factorization of a general band matrix using the unblocked version of the algo...
Definition cgbtf2.f:145
subroutine cgbtrf(m, n, kl, ku, ab, ldab, ipiv, info)
CGBTRF
Definition cgbtrf.f:144
subroutine cgbtrs(trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info)
CGBTRS
Definition cgbtrs.f:138
subroutine cgecon(norm, n, a, lda, anorm, rcond, work, rwork, info)
CGECON
Definition cgecon.f:132
subroutine cgeequ(m, n, a, lda, r, c, rowcnd, colcnd, amax, info)
CGEEQU
Definition cgeequ.f:140
subroutine cgerfs(trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork, info)
CGERFS
Definition cgerfs.f:186
subroutine cgetf2(m, n, a, lda, ipiv, info)
CGETF2 computes the LU factorization of a general m-by-n matrix using partial pivoting with row inter...
Definition cgetf2.f:108
subroutine cgetrf(m, n, a, lda, ipiv, info)
CGETRF
Definition cgetrf.f:108
subroutine cgetri(n, a, lda, ipiv, work, lwork, info)
CGETRI
Definition cgetri.f:114
subroutine cgetrs(trans, n, nrhs, a, lda, ipiv, b, ldb, info)
CGETRS
Definition cgetrs.f:121
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: