LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
cerrge.f
Go to the documentation of this file.
1*> \brief \b CERRGE
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 CERRGE( 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*> CERRGE tests the error exits for the COMPLEX 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 complex_lin
52*
53* =====================================================================
54 SUBROUTINE cerrge( 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
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,
88 $ cgbtrs, cgecon, cgeequ, cgerfs, cgetf2, cgetrf,
89 $ cgetri, cgetrs, chkxer
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*
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
cerrge
subroutine cerrge(path, nunit)
CERRGE
Definition cerrge.f:55
cgbcon
subroutine cgbcon(norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond, work, rwork, info)
CGBCON
Definition cgbcon.f:147
cgbequ
subroutine cgbequ(m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd, amax, info)
CGBEQU
Definition cgbequ.f:154
cgbrfs
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
cgbtf2
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
cgbtrf
subroutine cgbtrf(m, n, kl, ku, ab, ldab, ipiv, info)
CGBTRF
Definition cgbtrf.f:144
cgbtrs
subroutine cgbtrs(trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info)
CGBTRS
Definition cgbtrs.f:138
cgecon
subroutine cgecon(norm, n, a, lda, anorm, rcond, work, rwork, info)
CGECON
Definition cgecon.f:132
cgeequ
subroutine cgeequ(m, n, a, lda, r, c, rowcnd, colcnd, amax, info)
CGEEQU
Definition cgeequ.f:140
cgerfs
subroutine cgerfs(trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork, info)
CGERFS
Definition cgerfs.f:186
cgetf2
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
cgetrf
subroutine cgetrf(m, n, a, lda, ipiv, info)
CGETRF
Definition cgetrf.f:108
cgetri
subroutine cgetri(n, a, lda, ipiv, work, lwork, info)
CGETRI
Definition cgetri.f:114
cgetrs
subroutine cgetrs(trans, n, nrhs, a, lda, ipiv, b, ldb, info)
CGETRS
Definition cgetrs.f:121