LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
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,
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
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:63
subroutine cerrge(PATH, NUNIT)
CERRGE
Definition: cerrge.f:55
subroutine cgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, RWORK, INFO)
CGBCON
Definition: cgbcon.f:147
subroutine cgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
CGBTRF
Definition: cgbtrf.f:144
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 cgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
CGBTRS
Definition: cgbtrs.f:138
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 cgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
CGBEQU
Definition: cgbequ.f:154
subroutine cgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CGETRS
Definition: cgetrs.f:121
subroutine cgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
CGEEQU
Definition: cgeequ.f:140
subroutine cgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
CGECON
Definition: cgecon.f:124
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 cgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
CGETRI
Definition: cgetri.f:114
subroutine cgetrf(M, N, A, LDA, IPIV, INFO)
CGETRF
Definition: cgetrf.f:108
subroutine cgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CGERFS
Definition: cgerfs.f:186