LAPACK  3.8.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.
Date
December 2016
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.
Date
December 2016

Definition at line 57 of file cerrge.f.

57 *
58 * -- LAPACK test routine (version 3.7.0) --
59 * -- LAPACK is a software package provided by Univ. of Tennessee, --
60 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
61 * December 2016
62 *
63 * .. Scalar Arguments ..
64  CHARACTER*3 path
65  INTEGER nunit
66 * ..
67 *
68 * =====================================================================
69 *
70 * .. Parameters ..
71  INTEGER nmax
72  parameter( nmax = 4 )
73 * ..
74 * .. Local Scalars ..
75  CHARACTER*2 c2
76  INTEGER i, info, j
77  REAL anrm, ccond, rcond
78 * ..
79 * .. Local Arrays ..
80  INTEGER ip( nmax )
81  REAL r( nmax ), r1( nmax ), r2( nmax )
82  COMPLEX a( nmax, nmax ), af( nmax, nmax ), b( nmax ),
83  $ w( 2*nmax ), x( nmax )
84 * ..
85 * .. External Functions ..
86  LOGICAL lsamen
87  EXTERNAL lsamen
88 * ..
89 * .. External Subroutines ..
90  EXTERNAL alaesm, cgbcon, cgbequ, cgbrfs, cgbtf2, cgbtrf,
92  $ cgetri, cgetrs, chkxer
93 * ..
94 * .. Scalars in Common ..
95  LOGICAL lerr, ok
96  CHARACTER*32 srnamt
97  INTEGER infot, nout
98 * ..
99 * .. Common blocks ..
100  COMMON / infoc / infot, nout, ok, lerr
101  COMMON / srnamc / srnamt
102 * ..
103 * .. Intrinsic Functions ..
104  INTRINSIC cmplx, real
105 * ..
106 * .. Executable Statements ..
107 *
108  nout = nunit
109  WRITE( nout, fmt = * )
110  c2 = path( 2: 3 )
111 *
112 * Set the variables to innocuous values.
113 *
114  DO 20 j = 1, nmax
115  DO 10 i = 1, nmax
116  a( i, j ) = cmplx( 1. / REAL( I+J ), -1. / REAL( I+J ) )
117  af( i, j ) = cmplx( 1. / REAL( I+J ), -1. / REAL( I+J ) )
118  10 CONTINUE
119  b( j ) = 0.
120  r1( j ) = 0.
121  r2( j ) = 0.
122  w( j ) = 0.
123  x( j ) = 0.
124  ip( j ) = j
125  20 CONTINUE
126  ok = .true.
127 *
128 * Test error exits of the routines that use the LU decomposition
129 * of a general matrix.
130 *
131  IF( lsamen( 2, c2, 'GE' ) ) THEN
132 *
133 * CGETRF
134 *
135  srnamt = 'CGETRF'
136  infot = 1
137  CALL cgetrf( -1, 0, a, 1, ip, info )
138  CALL chkxer( 'CGETRF', infot, nout, lerr, ok )
139  infot = 2
140  CALL cgetrf( 0, -1, a, 1, ip, info )
141  CALL chkxer( 'CGETRF', infot, nout, lerr, ok )
142  infot = 4
143  CALL cgetrf( 2, 1, a, 1, ip, info )
144  CALL chkxer( 'CGETRF', infot, nout, lerr, ok )
145 *
146 * CGETF2
147 *
148  srnamt = 'CGETF2'
149  infot = 1
150  CALL cgetf2( -1, 0, a, 1, ip, info )
151  CALL chkxer( 'CGETF2', infot, nout, lerr, ok )
152  infot = 2
153  CALL cgetf2( 0, -1, a, 1, ip, info )
154  CALL chkxer( 'CGETF2', infot, nout, lerr, ok )
155  infot = 4
156  CALL cgetf2( 2, 1, a, 1, ip, info )
157  CALL chkxer( 'CGETF2', infot, nout, lerr, ok )
158 *
159 * CGETRI
160 *
161  srnamt = 'CGETRI'
162  infot = 1
163  CALL cgetri( -1, a, 1, ip, w, 1, info )
164  CALL chkxer( 'CGETRI', infot, nout, lerr, ok )
165  infot = 3
166  CALL cgetri( 2, a, 1, ip, w, 2, info )
167  CALL chkxer( 'CGETRI', infot, nout, lerr, ok )
168  infot = 6
169  CALL cgetri( 2, a, 2, ip, w, 1, info )
170  CALL chkxer( 'CGETRI', infot, nout, lerr, ok )
171 *
172 * CGETRS
173 *
174  srnamt = 'CGETRS'
175  infot = 1
176  CALL cgetrs( '/', 0, 0, a, 1, ip, b, 1, info )
177  CALL chkxer( 'CGETRS', infot, nout, lerr, ok )
178  infot = 2
179  CALL cgetrs( 'N', -1, 0, a, 1, ip, b, 1, info )
180  CALL chkxer( 'CGETRS', infot, nout, lerr, ok )
181  infot = 3
182  CALL cgetrs( 'N', 0, -1, a, 1, ip, b, 1, info )
183  CALL chkxer( 'CGETRS', infot, nout, lerr, ok )
184  infot = 5
185  CALL cgetrs( 'N', 2, 1, a, 1, ip, b, 2, info )
186  CALL chkxer( 'CGETRS', infot, nout, lerr, ok )
187  infot = 8
188  CALL cgetrs( 'N', 2, 1, a, 2, ip, b, 1, info )
189  CALL chkxer( 'CGETRS', infot, nout, lerr, ok )
190 *
191 * CGERFS
192 *
193  srnamt = 'CGERFS'
194  infot = 1
195  CALL cgerfs( '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
196  $ r, info )
197  CALL chkxer( 'CGERFS', infot, nout, lerr, ok )
198  infot = 2
199  CALL cgerfs( 'N', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
200  $ w, r, info )
201  CALL chkxer( 'CGERFS', infot, nout, lerr, ok )
202  infot = 3
203  CALL cgerfs( 'N', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
204  $ w, r, info )
205  CALL chkxer( 'CGERFS', infot, nout, lerr, ok )
206  infot = 5
207  CALL cgerfs( 'N', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
208  $ r, info )
209  CALL chkxer( 'CGERFS', infot, nout, lerr, ok )
210  infot = 7
211  CALL cgerfs( 'N', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
212  $ r, info )
213  CALL chkxer( 'CGERFS', infot, nout, lerr, ok )
214  infot = 10
215  CALL cgerfs( 'N', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
216  $ r, info )
217  CALL chkxer( 'CGERFS', infot, nout, lerr, ok )
218  infot = 12
219  CALL cgerfs( 'N', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
220  $ r, info )
221  CALL chkxer( 'CGERFS', infot, nout, lerr, ok )
222 *
223 * CGECON
224 *
225  srnamt = 'CGECON'
226  infot = 1
227  CALL cgecon( '/', 0, a, 1, anrm, rcond, w, r, info )
228  CALL chkxer( 'CGECON', infot, nout, lerr, ok )
229  infot = 2
230  CALL cgecon( '1', -1, a, 1, anrm, rcond, w, r, info )
231  CALL chkxer( 'CGECON', infot, nout, lerr, ok )
232  infot = 4
233  CALL cgecon( '1', 2, a, 1, anrm, rcond, w, r, info )
234  CALL chkxer( 'CGECON', infot, nout, lerr, ok )
235 *
236 * CGEEQU
237 *
238  srnamt = 'CGEEQU'
239  infot = 1
240  CALL cgeequ( -1, 0, a, 1, r1, r2, rcond, ccond, anrm, info )
241  CALL chkxer( 'CGEEQU', infot, nout, lerr, ok )
242  infot = 2
243  CALL cgeequ( 0, -1, a, 1, r1, r2, rcond, ccond, anrm, info )
244  CALL chkxer( 'CGEEQU', infot, nout, lerr, ok )
245  infot = 4
246  CALL cgeequ( 2, 2, a, 1, r1, r2, rcond, ccond, anrm, info )
247  CALL chkxer( 'CGEEQU', infot, nout, lerr, ok )
248 *
249 * Test error exits of the routines that use the LU decomposition
250 * of a general band matrix.
251 *
252  ELSE IF( lsamen( 2, c2, 'GB' ) ) THEN
253 *
254 * CGBTRF
255 *
256  srnamt = 'CGBTRF'
257  infot = 1
258  CALL cgbtrf( -1, 0, 0, 0, a, 1, ip, info )
259  CALL chkxer( 'CGBTRF', infot, nout, lerr, ok )
260  infot = 2
261  CALL cgbtrf( 0, -1, 0, 0, a, 1, ip, info )
262  CALL chkxer( 'CGBTRF', infot, nout, lerr, ok )
263  infot = 3
264  CALL cgbtrf( 1, 1, -1, 0, a, 1, ip, info )
265  CALL chkxer( 'CGBTRF', infot, nout, lerr, ok )
266  infot = 4
267  CALL cgbtrf( 1, 1, 0, -1, a, 1, ip, info )
268  CALL chkxer( 'CGBTRF', infot, nout, lerr, ok )
269  infot = 6
270  CALL cgbtrf( 2, 2, 1, 1, a, 3, ip, info )
271  CALL chkxer( 'CGBTRF', infot, nout, lerr, ok )
272 *
273 * CGBTF2
274 *
275  srnamt = 'CGBTF2'
276  infot = 1
277  CALL cgbtf2( -1, 0, 0, 0, a, 1, ip, info )
278  CALL chkxer( 'CGBTF2', infot, nout, lerr, ok )
279  infot = 2
280  CALL cgbtf2( 0, -1, 0, 0, a, 1, ip, info )
281  CALL chkxer( 'CGBTF2', infot, nout, lerr, ok )
282  infot = 3
283  CALL cgbtf2( 1, 1, -1, 0, a, 1, ip, info )
284  CALL chkxer( 'CGBTF2', infot, nout, lerr, ok )
285  infot = 4
286  CALL cgbtf2( 1, 1, 0, -1, a, 1, ip, info )
287  CALL chkxer( 'CGBTF2', infot, nout, lerr, ok )
288  infot = 6
289  CALL cgbtf2( 2, 2, 1, 1, a, 3, ip, info )
290  CALL chkxer( 'CGBTF2', infot, nout, lerr, ok )
291 *
292 * CGBTRS
293 *
294  srnamt = 'CGBTRS'
295  infot = 1
296  CALL cgbtrs( '/', 0, 0, 0, 1, a, 1, ip, b, 1, info )
297  CALL chkxer( 'CGBTRS', infot, nout, lerr, ok )
298  infot = 2
299  CALL cgbtrs( 'N', -1, 0, 0, 1, a, 1, ip, b, 1, info )
300  CALL chkxer( 'CGBTRS', infot, nout, lerr, ok )
301  infot = 3
302  CALL cgbtrs( 'N', 1, -1, 0, 1, a, 1, ip, b, 1, info )
303  CALL chkxer( 'CGBTRS', infot, nout, lerr, ok )
304  infot = 4
305  CALL cgbtrs( 'N', 1, 0, -1, 1, a, 1, ip, b, 1, info )
306  CALL chkxer( 'CGBTRS', infot, nout, lerr, ok )
307  infot = 5
308  CALL cgbtrs( 'N', 1, 0, 0, -1, a, 1, ip, b, 1, info )
309  CALL chkxer( 'CGBTRS', infot, nout, lerr, ok )
310  infot = 7
311  CALL cgbtrs( 'N', 2, 1, 1, 1, a, 3, ip, b, 2, info )
312  CALL chkxer( 'CGBTRS', infot, nout, lerr, ok )
313  infot = 10
314  CALL cgbtrs( 'N', 2, 0, 0, 1, a, 1, ip, b, 1, info )
315  CALL chkxer( 'CGBTRS', infot, nout, lerr, ok )
316 *
317 * CGBRFS
318 *
319  srnamt = 'CGBRFS'
320  infot = 1
321  CALL cgbrfs( '/', 0, 0, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
322  $ r2, w, r, info )
323  CALL chkxer( 'CGBRFS', infot, nout, lerr, ok )
324  infot = 2
325  CALL cgbrfs( 'N', -1, 0, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
326  $ r2, w, r, info )
327  CALL chkxer( 'CGBRFS', infot, nout, lerr, ok )
328  infot = 3
329  CALL cgbrfs( 'N', 1, -1, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
330  $ r2, w, r, info )
331  CALL chkxer( 'CGBRFS', infot, nout, lerr, ok )
332  infot = 4
333  CALL cgbrfs( 'N', 1, 0, -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
334  $ r2, w, r, info )
335  CALL chkxer( 'CGBRFS', infot, nout, lerr, ok )
336  infot = 5
337  CALL cgbrfs( 'N', 1, 0, 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1,
338  $ r2, w, r, info )
339  CALL chkxer( 'CGBRFS', infot, nout, lerr, ok )
340  infot = 7
341  CALL cgbrfs( 'N', 2, 1, 1, 1, a, 2, af, 4, ip, b, 2, x, 2, r1,
342  $ r2, w, r, info )
343  CALL chkxer( 'CGBRFS', infot, nout, lerr, ok )
344  infot = 9
345  CALL cgbrfs( 'N', 2, 1, 1, 1, a, 3, af, 3, ip, b, 2, x, 2, r1,
346  $ r2, w, r, info )
347  CALL chkxer( 'CGBRFS', infot, nout, lerr, ok )
348  infot = 12
349  CALL cgbrfs( 'N', 2, 0, 0, 1, a, 1, af, 1, ip, b, 1, x, 2, r1,
350  $ r2, w, r, info )
351  CALL chkxer( 'CGBRFS', infot, nout, lerr, ok )
352  infot = 14
353  CALL cgbrfs( 'N', 2, 0, 0, 1, a, 1, af, 1, ip, b, 2, x, 1, r1,
354  $ r2, w, r, info )
355  CALL chkxer( 'CGBRFS', infot, nout, lerr, ok )
356 *
357 * CGBCON
358 *
359  srnamt = 'CGBCON'
360  infot = 1
361  CALL cgbcon( '/', 0, 0, 0, a, 1, ip, anrm, rcond, w, r, info )
362  CALL chkxer( 'CGBCON', infot, nout, lerr, ok )
363  infot = 2
364  CALL cgbcon( '1', -1, 0, 0, a, 1, ip, anrm, rcond, w, r, info )
365  CALL chkxer( 'CGBCON', infot, nout, lerr, ok )
366  infot = 3
367  CALL cgbcon( '1', 1, -1, 0, a, 1, ip, anrm, rcond, w, r, info )
368  CALL chkxer( 'CGBCON', infot, nout, lerr, ok )
369  infot = 4
370  CALL cgbcon( '1', 1, 0, -1, a, 1, ip, anrm, rcond, w, r, info )
371  CALL chkxer( 'CGBCON', infot, nout, lerr, ok )
372  infot = 6
373  CALL cgbcon( '1', 2, 1, 1, a, 3, ip, anrm, rcond, w, r, info )
374  CALL chkxer( 'CGBCON', infot, nout, lerr, ok )
375 *
376 * CGBEQU
377 *
378  srnamt = 'CGBEQU'
379  infot = 1
380  CALL cgbequ( -1, 0, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
381  $ info )
382  CALL chkxer( 'CGBEQU', infot, nout, lerr, ok )
383  infot = 2
384  CALL cgbequ( 0, -1, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
385  $ info )
386  CALL chkxer( 'CGBEQU', infot, nout, lerr, ok )
387  infot = 3
388  CALL cgbequ( 1, 1, -1, 0, a, 1, r1, r2, rcond, ccond, anrm,
389  $ info )
390  CALL chkxer( 'CGBEQU', infot, nout, lerr, ok )
391  infot = 4
392  CALL cgbequ( 1, 1, 0, -1, a, 1, r1, r2, rcond, ccond, anrm,
393  $ info )
394  CALL chkxer( 'CGBEQU', infot, nout, lerr, ok )
395  infot = 6
396  CALL cgbequ( 2, 2, 1, 1, a, 2, r1, r2, rcond, ccond, anrm,
397  $ info )
398  CALL chkxer( 'CGBEQU', infot, nout, lerr, ok )
399  END IF
400 *
401 * Print a summary line.
402 *
403  CALL alaesm( path, ok, nout )
404 *
405  RETURN
406 *
407 * End of CERRGE
408 *
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:208
subroutine cgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
CGBEQU
Definition: cgbequ.f:156
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:147
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:65
subroutine cgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CGETRS
Definition: cgetrs.f:123
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:110
subroutine cgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
CGEEQU
Definition: cgeequ.f:142
subroutine cgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
CGETRI
Definition: cgetri.f:116
subroutine cgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, RWORK, INFO)
CGBCON
Definition: cgbcon.f:149
subroutine cgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
CGBTRF
Definition: cgbtrf.f:146
subroutine cgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CGERFS
Definition: cgerfs.f:188
subroutine cgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
CGECON
Definition: cgecon.f:126
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
subroutine cgetrf(M, N, A, LDA, IPIV, INFO)
CGETRF
Definition: cgetrf.f:110
subroutine cgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
CGBTRS
Definition: cgbtrs.f:140
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:76
Here is the call graph for this function:
Here is the caller graph for this function: