LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ cerrge()

subroutine cerrge ( character*3  PATH,
integer  NUNIT 
)

CERRGE

CERRGEX

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.
Purpose:
 CERRGE tests the error exits for the COMPLEX routines
 for general matrices.

 Note that this file is used only when the XBLAS are available,
 otherwise cerrge.f defines this subroutine.
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,
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 *
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:74
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:63
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
Here is the call graph for this function:
Here is the caller graph for this function: