OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
zerrge.f
Go to the documentation of this file.
1*> \brief \b ZERRGE
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 ZERRGE( 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*> ZERRGE tests the error exits for the COMPLEX*16 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 complex16_lin
52*
53* =====================================================================
54 SUBROUTINE zerrge( 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 DOUBLE PRECISION ANRM, CCOND, RCOND
75* ..
76* .. Local Arrays ..
77 INTEGER IP( NMAX )
78 DOUBLE PRECISION R( NMAX ), R1( NMAX ), R2( NMAX )
79 COMPLEX*16 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, chkxer, zgbcon, zgbequ, zgbrfs, zgbtf2,
88 $ zgbtrf, zgbtrs, zgecon, zgeequ, zgerfs, zgetf2,
89 $ zgetrf, zgetri, zgetrs
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 dble, dcmplx
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 ) = dcmplx( 1.d0 / dble( i+j ),
114 $ -1.d0 / dble( i+j ) )
115 af( i, j ) = dcmplx( 1.d0 / dble( i+j ),
116 $ -1.d0 / dble( i+j ) )
117 10 CONTINUE
118 b( j ) = 0.d0
119 r1( j ) = 0.d0
120 r2( j ) = 0.d0
121 w( j ) = 0.d0
122 x( j ) = 0.d0
123 ip( j ) = j
124 20 CONTINUE
125 ok = .true.
126*
127* Test error exits of the routines that use the LU decomposition
128* of a general matrix.
129*
130 IF( lsamen( 2, c2, 'GE' ) ) THEN
131*
132* ZGETRF
133*
134 srnamt = 'ZGETRF'
135 infot = 1
136 CALL zgetrf( -1, 0, a, 1, ip, info )
137 CALL chkxer( 'ZGETRF', infot, nout, lerr, ok )
138 infot = 2
139 CALL zgetrf( 0, -1, a, 1, ip, info )
140 CALL chkxer( 'ZGETRF', infot, nout, lerr, ok )
141 infot = 4
142 CALL zgetrf( 2, 1, a, 1, ip, info )
143 CALL chkxer( 'ZGETRF', infot, nout, lerr, ok )
144*
145* ZGETF2
146*
147 srnamt = 'ZGETF2'
148 infot = 1
149 CALL zgetf2( -1, 0, a, 1, ip, info )
150 CALL chkxer( 'ZGETF2', infot, nout, lerr, ok )
151 infot = 2
152 CALL zgetf2( 0, -1, a, 1, ip, info )
153 CALL chkxer( 'ZGETF2', infot, nout, lerr, ok )
154 infot = 4
155 CALL zgetf2( 2, 1, a, 1, ip, info )
156 CALL chkxer( 'ZGETF2', infot, nout, lerr, ok )
157*
158* ZGETRI
159*
160 srnamt = 'ZGETRI'
161 infot = 1
162 CALL zgetri( -1, a, 1, ip, w, 1, info )
163 CALL chkxer( 'ZGETRI', infot, nout, lerr, ok )
164 infot = 3
165 CALL zgetri( 2, a, 1, ip, w, 2, info )
166 CALL chkxer( 'ZGETRI', infot, nout, lerr, ok )
167 infot = 6
168 CALL zgetri( 2, a, 2, ip, w, 1, info )
169 CALL chkxer( 'ZGETRI', infot, nout, lerr, ok )
170*
171* ZGETRS
172*
173 srnamt = 'ZGETRS'
174 infot = 1
175 CALL zgetrs( '/', 0, 0, a, 1, ip, b, 1, info )
176 CALL chkxer( 'zgetrs', INFOT, NOUT, LERR, OK )
177 INFOT = 2
178 CALL ZGETRS( 'n', -1, 0, A, 1, IP, B, 1, INFO )
179 CALL CHKXER( 'zgetrs', INFOT, NOUT, LERR, OK )
180 INFOT = 3
181 CALL ZGETRS( 'n', 0, -1, A, 1, IP, B, 1, INFO )
182 CALL CHKXER( 'zgetrs', INFOT, NOUT, LERR, OK )
183 INFOT = 5
184 CALL ZGETRS( 'n', 2, 1, A, 1, IP, B, 2, INFO )
185 CALL CHKXER( 'zgetrs', INFOT, NOUT, LERR, OK )
186 INFOT = 8
187 CALL ZGETRS( 'n', 2, 1, a, 2, ip, b, 1, info )
188 CALL chkxer( 'ZGETRS', infot, nout, lerr, ok )
189*
190* ZGERFS
191*
192 srnamt = 'ZGERFS'
193 infot = 1
194 CALL zgerfs( '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
195 $ r, info )
196 CALL chkxer( 'ZGERFS', infot, nout, lerr, ok )
197 infot = 2
198 CALL zgerfs( 'N', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
199 $ w, r, info )
200 CALL chkxer( 'ZGERFS', infot, nout, lerr, ok )
201 infot = 3
202 CALL zgerfs( 'N', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
203 $ w, r, info )
204 CALL chkxer( 'ZGERFS', infot, nout, lerr, ok )
205 infot = 5
206 CALL zgerfs( 'N', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
207 $ r, info )
208 CALL chkxer( 'ZGERFS', infot, nout, lerr, ok )
209 infot = 7
210 CALL zgerfs( 'N', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
211 $ r, info )
212 CALL chkxer( 'ZGERFS', infot, nout, lerr, ok )
213 infot = 10
214 CALL zgerfs( 'N', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
215 $ r, info )
216 CALL chkxer( 'ZGERFS', infot, nout, lerr, ok )
217 infot = 12
218 CALL zgerfs( 'N', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
219 $ r, info )
220 CALL chkxer( 'ZGERFS', infot, nout, lerr, ok )
221*
222* ZGECON
223*
224 srnamt = 'ZGECON'
225 infot = 1
226 CALL zgecon( '/', 0, a, 1, anrm, rcond, w, r, info )
227 CALL chkxer( 'ZGECON', infot, nout, lerr, ok )
228 infot = 2
229 CALL zgecon( '1', -1, a, 1, anrm, rcond, w, r, info )
230 CALL chkxer( 'ZGECON', infot, nout, lerr, ok )
231 infot = 4
232 CALL zgecon( '1', 2, a, 1, anrm, rcond, w, r, info )
233 CALL chkxer( 'ZGECON', infot, nout, lerr, ok )
234*
235* ZGEEQU
236*
237 srnamt = 'zgeequ'
238 INFOT = 1
239 CALL ZGEEQU( -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
240 CALL CHKXER( 'zgeequ', INFOT, NOUT, LERR, OK )
241 INFOT = 2
242 CALL ZGEEQU( 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
243 CALL CHKXER( 'zgeequ', INFOT, NOUT, LERR, OK )
244 INFOT = 4
245 CALL ZGEEQU( 2, 2, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
246 CALL CHKXER( 'zgeequ', INFOT, NOUT, LERR, OK )
247*
248* Test error exits of the routines that use the LU decomposition
249* of a general band matrix.
250*
251 ELSE IF( LSAMEN( 2, C2, 'gb' ) ) THEN
252*
253* ZGBTRF
254*
255 SRNAMT = 'zgbtrf'
256 INFOT = 1
257 CALL ZGBTRF( -1, 0, 0, 0, A, 1, IP, INFO )
258 CALL CHKXER( 'zgbtrf', INFOT, NOUT, LERR, OK )
259 INFOT = 2
260 CALL ZGBTRF( 0, -1, 0, 0, A, 1, IP, INFO )
261 CALL CHKXER( 'zgbtrf', INFOT, NOUT, LERR, OK )
262 INFOT = 3
263 CALL ZGBTRF( 1, 1, -1, 0, A, 1, IP, INFO )
264 CALL CHKXER( 'zgbtrf', INFOT, NOUT, LERR, OK )
265 INFOT = 4
266 CALL ZGBTRF( 1, 1, 0, -1, A, 1, IP, INFO )
267 CALL CHKXER( 'zgbtrf', INFOT, NOUT, LERR, OK )
268 INFOT = 6
269 CALL ZGBTRF( 2, 2, 1, 1, A, 3, IP, INFO )
270 CALL CHKXER( 'zgbtrf', INFOT, NOUT, LERR, OK )
271*
272* ZGBTF2
273*
274 SRNAMT = 'zgbtf2'
275 INFOT = 1
276 CALL ZGBTF2( -1, 0, 0, 0, A, 1, IP, INFO )
277 CALL CHKXER( 'zgbtf2', INFOT, NOUT, LERR, OK )
278 INFOT = 2
279 CALL ZGBTF2( 0, -1, 0, 0, A, 1, IP, INFO )
280 CALL CHKXER( 'zgbtf2', INFOT, NOUT, LERR, OK )
281 INFOT = 3
282 CALL ZGBTF2( 1, 1, -1, 0, A, 1, IP, INFO )
283 CALL CHKXER( 'zgbtf2', INFOT, NOUT, LERR, OK )
284 INFOT = 4
285 CALL ZGBTF2( 1, 1, 0, -1, A, 1, IP, INFO )
286 CALL CHKXER( 'zgbtf2', INFOT, NOUT, LERR, OK )
287 INFOT = 6
288 CALL ZGBTF2( 2, 2, 1, 1, A, 3, IP, INFO )
289 CALL CHKXER( 'zgbtf2', INFOT, NOUT, LERR, OK )
290*
291* ZGBTRS
292*
293 SRNAMT = 'zgbtrs'
294 INFOT = 1
295 CALL ZGBTRS( '/', 0, 0, 0, 1, A, 1, IP, B, 1, INFO )
296 CALL CHKXER( 'zgbtrs', INFOT, NOUT, LERR, OK )
297 INFOT = 2
298 CALL ZGBTRS( 'n', -1, 0, 0, 1, A, 1, IP, B, 1, INFO )
299 CALL CHKXER( 'zgbtrs', INFOT, NOUT, LERR, OK )
300 INFOT = 3
301 CALL ZGBTRS( 'n', 1, -1, 0, 1, A, 1, IP, B, 1, INFO )
302 CALL CHKXER( 'zgbtrs', INFOT, NOUT, LERR, OK )
303 INFOT = 4
304 CALL ZGBTRS( 'n', 1, 0, -1, 1, A, 1, IP, B, 1, INFO )
305 CALL CHKXER( 'zgbtrs', INFOT, NOUT, LERR, OK )
306 INFOT = 5
307 CALL ZGBTRS( 'n', 1, 0, 0, -1, A, 1, IP, B, 1, INFO )
308 CALL CHKXER( 'zgbtrs', INFOT, NOUT, LERR, OK )
309 INFOT = 7
310 CALL ZGBTRS( 'n', 2, 1, 1, 1, A, 3, IP, B, 2, INFO )
311 CALL CHKXER( 'zgbtrs', INFOT, NOUT, LERR, OK )
312 INFOT = 10
313 CALL ZGBTRS( 'n', 2, 0, 0, 1, A, 1, IP, B, 1, INFO )
314 CALL CHKXER( 'zgbtrs', INFOT, NOUT, LERR, OK )
315*
316* ZGBRFS
317*
318 SRNAMT = 'zgbrfs'
319 INFOT = 1
320 CALL ZGBRFS( '/', 0, 0, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1,
321 $ R2, W, R, INFO )
322 CALL CHKXER( 'zgbrfs', INFOT, NOUT, LERR, OK )
323 INFOT = 2
324 CALL ZGBRFS( 'n', -1, 0, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1,
325 $ R2, W, R, INFO )
326 CALL CHKXER( 'zgbrfs', INFOT, NOUT, LERR, OK )
327 INFOT = 3
328 CALL ZGBRFS( 'n', 1, -1, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1,
329 $ R2, W, R, INFO )
330 CALL CHKXER( 'zgbrfs', INFOT, NOUT, LERR, OK )
331 INFOT = 4
332 CALL ZGBRFS( 'n', 1, 0, -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1,
333 $ R2, W, R, INFO )
334 CALL CHKXER( 'zgbrfs', INFOT, NOUT, LERR, OK )
335 INFOT = 5
336 CALL ZGBRFS( 'n', 1, 0, 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1,
337 $ R2, W, R, INFO )
338 CALL CHKXER( 'zgbrfs', INFOT, NOUT, LERR, OK )
339 INFOT = 7
340 CALL ZGBRFS( 'n', 2, 1, 1, 1, A, 2, AF, 4, IP, B, 2, X, 2, R1,
341 $ R2, W, R, INFO )
342 CALL CHKXER( 'zgbrfs', INFOT, NOUT, LERR, OK )
343 INFOT = 9
344 CALL ZGBRFS( 'n', 2, 1, 1, 1, A, 3, AF, 3, IP, B, 2, X, 2, R1,
345 $ R2, W, R, INFO )
346 CALL CHKXER( 'zgbrfs', INFOT, NOUT, LERR, OK )
347 INFOT = 12
348 CALL ZGBRFS( 'n', 2, 0, 0, 1, A, 1, AF, 1, IP, B, 1, X, 2, R1,
349 $ R2, W, R, INFO )
350 CALL CHKXER( 'zgbrfs', infot, nout, lerr, ok )
351 infot = 14
352 CALL zgbrfs( 'N', 2, 0, 0, 1, a, 1, af, 1, ip, b, 2, x, 1, r1,
353 $ r2, w, r, info )
354 CALL chkxer( 'ZGBRFS', infot, nout, lerr, ok )
355*
356* ZGBCON
357*
358 srnamt = 'ZGBCON'
359 infot = 1
360 CALL zgbcon( '/', 0, 0, 0, a, 1, ip, anrm, rcond, w, r, info )
361 CALL chkxer( 'ZGBCON', infot, nout, lerr, ok )
362 infot = 2
363 CALL zgbcon( '1', -1, 0, 0, a, 1, ip, anrm, rcond, w, r, info )
364 CALL chkxer( 'ZGBCON', infot, nout, lerr, ok )
365 infot = 3
366 CALL zgbcon( '1', 1, -1, 0, a, 1, ip, anrm, rcond, w, r, info )
367 CALL chkxer( 'ZGBCON', infot, nout, lerr, ok )
368 infot = 4
369 CALL zgbcon( '1', 1, 0, -1, a, 1, ip, anrm, rcond, w, r, info )
370 CALL chkxer( 'ZGBCON', infot, nout, lerr, ok )
371 infot = 6
372 CALL zgbcon( '1', 2, 1, 1, a, 3, ip, anrm, rcond, w, r, info )
373 CALL chkxer( 'ZGBCON', infot, nout, lerr, ok )
374*
375* ZGBEQU
376*
377 srnamt = 'ZGBEQU'
378 infot = 1
379 CALL zgbequ( -1, 0, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
380 $ info )
381 CALL chkxer( 'ZGBEQU', infot, nout, lerr, ok )
382 infot = 2
383 CALL zgbequ( 0, -1, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
384 $ info )
385 CALL chkxer( 'ZGBEQU', infot, nout, lerr, ok )
386 infot = 3
387 CALL zgbequ( 1, 1, -1, 0, a, 1, r1, r2, rcond, ccond, anrm,
388 $ info )
389 CALL chkxer( 'ZGBEQU', infot, nout, lerr, ok )
390 infot = 4
391 CALL zgbequ( 1, 1, 0, -1, a, 1, r1, r2, rcond, ccond, anrm,
392 $ info )
393 CALL chkxer( 'ZGBEQU', infot, nout, lerr, ok )
394 infot = 6
395 CALL zgbequ( 2, 2, 1, 1, a, 2, r1, r2, rcond, ccond, anrm,
396 $ info )
397 CALL chkxer( 'ZGBEQU', infot, nout, lerr, ok )
398 END IF
399*
400* Print a summary line.
401*
402 CALL alaesm( path, ok, nout )
403*
404 RETURN
405*
406* End of ZERRGE
407*
408 END
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3196
alaesm
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
zgbtf2
subroutine zgbtf2(m, n, kl, ku, ab, ldab, ipiv, info)
ZGBTF2 computes the LU factorization of a general band matrix using the unblocked version of the algo...
Definition zgbtf2.f:145
zgbtrs
subroutine zgbtrs(trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info)
ZGBTRS
Definition zgbtrs.f:138
zgbtrf
subroutine zgbtrf(m, n, kl, ku, ab, ldab, ipiv, info)
ZGBTRF
Definition zgbtrf.f:144
zgbcon
subroutine zgbcon(norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond, work, rwork, info)
ZGBCON
Definition zgbcon.f:147
zgbrfs
subroutine zgbrfs(trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork, info)
ZGBRFS
Definition zgbrfs.f:206
zgbequ
subroutine zgbequ(m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd, amax, info)
ZGBEQU
Definition zgbequ.f:154
zgerfs
subroutine zgerfs(trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork, info)
ZGERFS
Definition zgerfs.f:186
zgetri
subroutine zgetri(n, a, lda, ipiv, work, lwork, info)
ZGETRI
Definition zgetri.f:114
zgecon
subroutine zgecon(norm, n, a, lda, anorm, rcond, work, rwork, info)
ZGECON
Definition zgecon.f:124
zgetrs
subroutine zgetrs(trans, n, nrhs, a, lda, ipiv, b, ldb, info)
ZGETRS
Definition zgetrs.f:121
zgetf2
subroutine zgetf2(m, n, a, lda, ipiv, info)
ZGETF2 computes the LU factorization of a general m-by-n matrix using partial pivoting with row inter...
Definition zgetf2.f:108
zgeequ
subroutine zgeequ(m, n, a, lda, r, c, rowcnd, colcnd, amax, info)
ZGEEQU
Definition zgeequ.f:140
zerrge
subroutine zerrge(path, nunit)
ZERRGE
Definition zerrge.f:55
zgetrf
subroutine zgetrf(m, n, a, lda, ipiv, info)
ZGETRF VARIANT: Crout Level 3 BLAS version of the algorithm.
Definition zgetrf.f:102