1       SUBROUTINE CERRGE( PATH, NUNIT )
  2 *
  3 *  -- LAPACK test routine (version 3.1) --
  4 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
  5 *     November 2006
  6 *
  7 *     .. Scalar Arguments ..
  8       CHARACTER*3        PATH
  9       INTEGER            NUNIT
 10 *     ..
 11 *
 12 *  Purpose
 13 *  =======
 14 *
 15 *  CERRGE tests the error exits for the COMPLEX routines
 16 *  for general matrices.
 17 *
 18 *  Arguments
 19 *  =========
 20 *
 21 *  PATH    (input) CHARACTER*3
 22 *          The LAPACK path name for the routines to be tested.
 23 *
 24 *  NUNIT   (input) INTEGER
 25 *          The unit number for output.
 26 *
 27 *  =====================================================================
 28 *
 29 *     .. Parameters ..
 30       INTEGER            NMAX
 31       PARAMETER          ( NMAX = 4 )
 32 *     ..
 33 *     .. Local Scalars ..
 34       CHARACTER*2        C2
 35       INTEGER            I, INFO, J
 36       REAL               ANRM, CCOND, RCOND
 37 *     ..
 38 *     .. Local Arrays ..
 39       INTEGER            IP( NMAX )
 40       REAL               R( NMAX ), R1( NMAX ), R2( NMAX )
 41       COMPLEX            A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
 42      $                   W( 2*NMAX ), X( NMAX )
 43 *     ..
 44 *     .. External Functions ..
 45       LOGICAL            LSAMEN
 46       EXTERNAL           LSAMEN
 47 *     ..
 48 *     .. External Subroutines ..
 49       EXTERNAL           ALAESM, CGBCON, CGBEQU, CGBRFS, CGBTF2, CGBTRF,
 50      $                   CGBTRS, CGECON, CGEEQU, CGERFS, CGETF2, CGETRF,
 51      $                   CGETRI, CGETRS, CHKXER
 52 *     ..
 53 *     .. Scalars in Common ..
 54       LOGICAL            LERR, OK
 55       CHARACTER*32       SRNAMT
 56       INTEGER            INFOT, NOUT
 57 *     ..
 58 *     .. Common blocks ..
 59       COMMON             / INFOC / INFOT, NOUT, OK, LERR
 60       COMMON             / SRNAMC / SRNAMT
 61 *     ..
 62 *     .. Intrinsic Functions ..
 63       INTRINSIC          CMPLX, REAL
 64 *     ..
 65 *     .. Executable Statements ..
 66 *
 67       NOUT = NUNIT
 68       WRITE( NOUT, FMT = * )
 69       C2 = PATH( 23 )
 70 *
 71 *     Set the variables to innocuous values.
 72 *
 73       DO 20 J = 1, NMAX
 74          DO 10 I = 1, NMAX
 75             A( I, J ) = CMPLX1/ REAL( I+J ), -1/ REAL( I+J ) )
 76             AF( I, J ) = CMPLX1/ REAL( I+J ), -1/ REAL( I+J ) )
 77    10    CONTINUE
 78          B( J ) = 0.
 79          R1( J ) = 0.
 80          R2( J ) = 0.
 81          W( J ) = 0.
 82          X( J ) = 0.
 83          IP( J ) = J
 84    20 CONTINUE
 85       OK = .TRUE.
 86 *
 87 *     Test error exits of the routines that use the LU decomposition
 88 *     of a general matrix.
 89 *
 90       IF( LSAMEN( 2, C2, 'GE' ) ) THEN
 91 *
 92 *        CGETRF
 93 *
 94          SRNAMT = 'CGETRF'
 95          INFOT = 1
 96          CALL CGETRF( -10, A, 1, IP, INFO )
 97          CALL CHKXER( 'CGETRF', INFOT, NOUT, LERR, OK )
 98          INFOT = 2
 99          CALL CGETRF( 0-1, A, 1, IP, INFO )
100          CALL CHKXER( 'CGETRF', INFOT, NOUT, LERR, OK )
101          INFOT = 4
102          CALL CGETRF( 21, A, 1, IP, INFO )
103          CALL CHKXER( 'CGETRF', INFOT, NOUT, LERR, OK )
104 *
105 *        CGETF2
106 *
107          SRNAMT = 'CGETF2'
108          INFOT = 1
109          CALL CGETF2( -10, A, 1, IP, INFO )
110          CALL CHKXER( 'CGETF2', INFOT, NOUT, LERR, OK )
111          INFOT = 2
112          CALL CGETF2( 0-1, A, 1, IP, INFO )
113          CALL CHKXER( 'CGETF2', INFOT, NOUT, LERR, OK )
114          INFOT = 4
115          CALL CGETF2( 21, A, 1, IP, INFO )
116          CALL CHKXER( 'CGETF2', INFOT, NOUT, LERR, OK )
117 *
118 *        CGETRI
119 *
120          SRNAMT = 'CGETRI'
121          INFOT = 1
122          CALL CGETRI( -1, A, 1, IP, W, 1, INFO )
123          CALL CHKXER( 'CGETRI', INFOT, NOUT, LERR, OK )
124          INFOT = 3
125          CALL CGETRI( 2, A, 1, IP, W, 2, INFO )
126          CALL CHKXER( 'CGETRI', INFOT, NOUT, LERR, OK )
127          INFOT = 6
128          CALL CGETRI( 2, A, 2, IP, W, 1, INFO )
129          CALL CHKXER( 'CGETRI', INFOT, NOUT, LERR, OK )
130 *
131 *        CGETRS
132 *
133          SRNAMT = 'CGETRS'
134          INFOT = 1
135          CALL CGETRS( '/'00, A, 1, IP, B, 1, INFO )
136          CALL CHKXER( 'CGETRS', INFOT, NOUT, LERR, OK )
137          INFOT = 2
138          CALL CGETRS( 'N'-10, A, 1, IP, B, 1, INFO )
139          CALL CHKXER( 'CGETRS', INFOT, NOUT, LERR, OK )
140          INFOT = 3
141          CALL CGETRS( 'N'0-1, A, 1, IP, B, 1, INFO )
142          CALL CHKXER( 'CGETRS', INFOT, NOUT, LERR, OK )
143          INFOT = 5
144          CALL CGETRS( 'N'21, A, 1, IP, B, 2, INFO )
145          CALL CHKXER( 'CGETRS', INFOT, NOUT, LERR, OK )
146          INFOT = 8
147          CALL CGETRS( 'N'21, A, 2, IP, B, 1, INFO )
148          CALL CHKXER( 'CGETRS', INFOT, NOUT, LERR, OK )
149 *
150 *        CGERFS
151 *
152          SRNAMT = 'CGERFS'
153          INFOT = 1
154          CALL CGERFS( '/'00, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
155      $                R, INFO )
156          CALL CHKXER( 'CGERFS', INFOT, NOUT, LERR, OK )
157          INFOT = 2
158          CALL CGERFS( 'N'-10, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
159      $                W, R, INFO )
160          CALL CHKXER( 'CGERFS', INFOT, NOUT, LERR, OK )
161          INFOT = 3
162          CALL CGERFS( 'N'0-1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
163      $                W, R, INFO )
164          CALL CHKXER( 'CGERFS', INFOT, NOUT, LERR, OK )
165          INFOT = 5
166          CALL CGERFS( 'N'21, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
167      $                R, INFO )
168          CALL CHKXER( 'CGERFS', INFOT, NOUT, LERR, OK )
169          INFOT = 7
170          CALL CGERFS( 'N'21, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
171      $                R, INFO )
172          CALL CHKXER( 'CGERFS', INFOT, NOUT, LERR, OK )
173          INFOT = 10
174          CALL CGERFS( 'N'21, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
175      $                R, INFO )
176          CALL CHKXER( 'CGERFS', INFOT, NOUT, LERR, OK )
177          INFOT = 12
178          CALL CGERFS( 'N'21, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
179      $                R, INFO )
180          CALL CHKXER( 'CGERFS', INFOT, NOUT, LERR, OK )
181 *
182 *        CGECON
183 *
184          SRNAMT = 'CGECON'
185          INFOT = 1
186          CALL CGECON( '/'0, A, 1, ANRM, RCOND, W, R, INFO )
187          CALL CHKXER( 'CGECON', INFOT, NOUT, LERR, OK )
188          INFOT = 2
189          CALL CGECON( '1'-1, A, 1, ANRM, RCOND, W, R, INFO )
190          CALL CHKXER( 'CGECON', INFOT, NOUT, LERR, OK )
191          INFOT = 4
192          CALL CGECON( '1'2, A, 1, ANRM, RCOND, W, R, INFO )
193          CALL CHKXER( 'CGECON', INFOT, NOUT, LERR, OK )
194 *
195 *        CGEEQU
196 *
197          SRNAMT = 'CGEEQU'
198          INFOT = 1
199          CALL CGEEQU( -10, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
200          CALL CHKXER( 'CGEEQU', INFOT, NOUT, LERR, OK )
201          INFOT = 2
202          CALL CGEEQU( 0-1, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
203          CALL CHKXER( 'CGEEQU', INFOT, NOUT, LERR, OK )
204          INFOT = 4
205          CALL CGEEQU( 22, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
206          CALL CHKXER( 'CGEEQU', INFOT, NOUT, LERR, OK )
207 *
208 *     Test error exits of the routines that use the LU decomposition
209 *     of a general band matrix.
210 *
211       ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN
212 *
213 *        CGBTRF
214 *
215          SRNAMT = 'CGBTRF'
216          INFOT = 1
217          CALL CGBTRF( -1000, A, 1, IP, INFO )
218          CALL CHKXER( 'CGBTRF', INFOT, NOUT, LERR, OK )
219          INFOT = 2
220          CALL CGBTRF( 0-100, A, 1, IP, INFO )
221          CALL CHKXER( 'CGBTRF', INFOT, NOUT, LERR, OK )
222          INFOT = 3
223          CALL CGBTRF( 11-10, A, 1, IP, INFO )
224          CALL CHKXER( 'CGBTRF', INFOT, NOUT, LERR, OK )
225          INFOT = 4
226          CALL CGBTRF( 110-1, A, 1, IP, INFO )
227          CALL CHKXER( 'CGBTRF', INFOT, NOUT, LERR, OK )
228          INFOT = 6
229          CALL CGBTRF( 2211, A, 3, IP, INFO )
230          CALL CHKXER( 'CGBTRF', INFOT, NOUT, LERR, OK )
231 *
232 *        CGBTF2
233 *
234          SRNAMT = 'CGBTF2'
235          INFOT = 1
236          CALL CGBTF2( -1000, A, 1, IP, INFO )
237          CALL CHKXER( 'CGBTF2', INFOT, NOUT, LERR, OK )
238          INFOT = 2
239          CALL CGBTF2( 0-100, A, 1, IP, INFO )
240          CALL CHKXER( 'CGBTF2', INFOT, NOUT, LERR, OK )
241          INFOT = 3
242          CALL CGBTF2( 11-10, A, 1, IP, INFO )
243          CALL CHKXER( 'CGBTF2', INFOT, NOUT, LERR, OK )
244          INFOT = 4
245          CALL CGBTF2( 110-1, A, 1, IP, INFO )
246          CALL CHKXER( 'CGBTF2', INFOT, NOUT, LERR, OK )
247          INFOT = 6
248          CALL CGBTF2( 2211, A, 3, IP, INFO )
249          CALL CHKXER( 'CGBTF2', INFOT, NOUT, LERR, OK )
250 *
251 *        CGBTRS
252 *
253          SRNAMT = 'CGBTRS'
254          INFOT = 1
255          CALL CGBTRS( '/'0001, A, 1, IP, B, 1, INFO )
256          CALL CHKXER( 'CGBTRS', INFOT, NOUT, LERR, OK )
257          INFOT = 2
258          CALL CGBTRS( 'N'-1001, A, 1, IP, B, 1, INFO )
259          CALL CHKXER( 'CGBTRS', INFOT, NOUT, LERR, OK )
260          INFOT = 3
261          CALL CGBTRS( 'N'1-101, A, 1, IP, B, 1, INFO )
262          CALL CHKXER( 'CGBTRS', INFOT, NOUT, LERR, OK )
263          INFOT = 4
264          CALL CGBTRS( 'N'10-11, A, 1, IP, B, 1, INFO )
265          CALL CHKXER( 'CGBTRS', INFOT, NOUT, LERR, OK )
266          INFOT = 5
267          CALL CGBTRS( 'N'100-1, A, 1, IP, B, 1, INFO )
268          CALL CHKXER( 'CGBTRS', INFOT, NOUT, LERR, OK )
269          INFOT = 7
270          CALL CGBTRS( 'N'2111, A, 3, IP, B, 2, INFO )
271          CALL CHKXER( 'CGBTRS', INFOT, NOUT, LERR, OK )
272          INFOT = 10
273          CALL CGBTRS( 'N'2001, A, 1, IP, B, 1, INFO )
274          CALL CHKXER( 'CGBTRS', INFOT, NOUT, LERR, OK )
275 *
276 *        CGBRFS
277 *
278          SRNAMT = 'CGBRFS'
279          INFOT = 1
280          CALL CGBRFS( '/'0000, A, 1, AF, 1, IP, B, 1, X, 1, R1,
281      $                R2, W, R, INFO )
282          CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK )
283          INFOT = 2
284          CALL CGBRFS( 'N'-1000, A, 1, AF, 1, IP, B, 1, X, 1, R1,
285      $                R2, W, R, INFO )
286          CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK )
287          INFOT = 3
288          CALL CGBRFS( 'N'1-100, A, 1, AF, 1, IP, B, 1, X, 1, R1,
289      $                R2, W, R, INFO )
290          CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK )
291          INFOT = 4
292          CALL CGBRFS( 'N'10-10, A, 1, AF, 1, IP, B, 1, X, 1, R1,
293      $                R2, W, R, INFO )
294          CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK )
295          INFOT = 5
296          CALL CGBRFS( 'N'100-1, A, 1, AF, 1, IP, B, 1, X, 1, R1,
297      $                R2, W, R, INFO )
298          CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK )
299          INFOT = 7
300          CALL CGBRFS( 'N'2111, A, 2, AF, 4, IP, B, 2, X, 2, R1,
301      $                R2, W, R, INFO )
302          CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK )
303          INFOT = 9
304          CALL CGBRFS( 'N'2111, A, 3, AF, 3, IP, B, 2, X, 2, R1,
305      $                R2, W, R, INFO )
306          CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK )
307          INFOT = 12
308          CALL CGBRFS( 'N'2001, A, 1, AF, 1, IP, B, 1, X, 2, R1,
309      $                R2, W, R, INFO )
310          CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK )
311          INFOT = 14
312          CALL CGBRFS( 'N'2001, A, 1, AF, 1, IP, B, 2, X, 1, R1,
313      $                R2, W, R, INFO )
314          CALL CHKXER( 'CGBRFS', INFOT, NOUT, LERR, OK )
315 *
316 *        CGBCON
317 *
318          SRNAMT = 'CGBCON'
319          INFOT = 1
320          CALL CGBCON( '/'000, A, 1, IP, ANRM, RCOND, W, R, INFO )
321          CALL CHKXER( 'CGBCON', INFOT, NOUT, LERR, OK )
322          INFOT = 2
323          CALL CGBCON( '1'-100, A, 1, IP, ANRM, RCOND, W, R, INFO )
324          CALL CHKXER( 'CGBCON', INFOT, NOUT, LERR, OK )
325          INFOT = 3
326          CALL CGBCON( '1'1-10, A, 1, IP, ANRM, RCOND, W, R, INFO )
327          CALL CHKXER( 'CGBCON', INFOT, NOUT, LERR, OK )
328          INFOT = 4
329          CALL CGBCON( '1'10-1, A, 1, IP, ANRM, RCOND, W, R, INFO )
330          CALL CHKXER( 'CGBCON', INFOT, NOUT, LERR, OK )
331          INFOT = 6
332          CALL CGBCON( '1'211, A, 3, IP, ANRM, RCOND, W, R, INFO )
333          CALL CHKXER( 'CGBCON', INFOT, NOUT, LERR, OK )
334 *
335 *        CGBEQU
336 *
337          SRNAMT = 'CGBEQU'
338          INFOT = 1
339          CALL CGBEQU( -1000, A, 1, R1, R2, RCOND, CCOND, ANRM,
340      $                INFO )
341          CALL CHKXER( 'CGBEQU', INFOT, NOUT, LERR, OK )
342          INFOT = 2
343          CALL CGBEQU( 0-100, A, 1, R1, R2, RCOND, CCOND, ANRM,
344      $                INFO )
345          CALL CHKXER( 'CGBEQU', INFOT, NOUT, LERR, OK )
346          INFOT = 3
347          CALL CGBEQU( 11-10, A, 1, R1, R2, RCOND, CCOND, ANRM,
348      $                INFO )
349          CALL CHKXER( 'CGBEQU', INFOT, NOUT, LERR, OK )
350          INFOT = 4
351          CALL CGBEQU( 110-1, A, 1, R1, R2, RCOND, CCOND, ANRM,
352      $                INFO )
353          CALL CHKXER( 'CGBEQU', INFOT, NOUT, LERR, OK )
354          INFOT = 6
355          CALL CGBEQU( 2211, A, 2, R1, R2, RCOND, CCOND, ANRM,
356      $                INFO )
357          CALL CHKXER( 'CGBEQU', INFOT, NOUT, LERR, OK )
358       END IF
359 *
360 *     Print a summary line.
361 *
362       CALL ALAESM( PATH, OK, NOUT )
363 *
364       RETURN
365 *
366 *     End of CERRGE
367 *
368       END