OpenRadioss 2025.1.11
OpenRadioss project
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
cmplx
float cmplx[2]
Definition pblas.h:136
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3196
alaesm
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
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
cgbtrf
subroutine cgbtrf(m, n, kl, ku, ab, ldab, ipiv, info)
CGBTRF
Definition cgbtrf.f:144
cgbcon
subroutine cgbcon(norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond, work, rwork, info)
CGBCON
Definition cgbcon.f:147
cgbtrs
subroutine cgbtrs(trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info)
CGBTRS
Definition cgbtrs.f:138
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
cgetrs
subroutine cgetrs(trans, n, nrhs, a, lda, ipiv, b, ldb, info)
CGETRS
Definition cgetrs.f:121
cgetrf
subroutine cgetrf(m, n, a, lda, ipiv, info)
CGETRF
Definition cgetrf.f:108
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
cgeequ
subroutine cgeequ(m, n, a, lda, r, c, rowcnd, colcnd, amax, info)
CGEEQU
Definition cgeequ.f:140
cgetri
subroutine cgetri(n, a, lda, ipiv, work, lwork, info)
CGETRI
Definition cgetri.f:114
cgecon
subroutine cgecon(norm, n, a, lda, anorm, rcond, work, rwork, info)
CGECON
Definition cgecon.f:124
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
cerrge
subroutine cerrge(path, nunit)
CERRGE
Definition cerrge.f:55