1       SUBROUTINE CERRED( 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 *  CERRED tests the error exits for the eigenvalue driver routines for
 16 *  REAL matrices:
 17 *
 18 *  PATH  driver   description
 19 *  ----  ------   -----------
 20 *  CEV   CGEEV    find eigenvalues/eigenvectors for nonsymmetric A
 21 *  CES   CGEES    find eigenvalues/Schur form for nonsymmetric A
 22 *  CVX   CGEEVX   CGEEV + balancing and condition estimation
 23 *  CSX   CGEESX   CGEES + balancing and condition estimation
 24 *  CBD   CGESVD   compute SVD of an M-by-N matrix A
 25 *        CGESDD   compute SVD of an M-by-N matrix A(by divide and
 26 *                 conquer)
 27 *
 28 *  Arguments
 29 *  =========
 30 *
 31 *  PATH    (input) CHARACTER*3
 32 *          The LAPACK path name for the routines to be tested.
 33 *
 34 *  NUNIT   (input) INTEGER
 35 *          The unit number for output.
 36 *
 37 *  =====================================================================
 38 *
 39 *     .. Parameters ..
 40       INTEGER            NMAX, LW
 41       PARAMETER          ( NMAX = 4, LW = 5*NMAX )
 42       REAL               ONE, ZERO
 43       PARAMETER          ( ONE = 1.0E0, ZERO = 0.0E0 )
 44 *     ..
 45 *     .. Local Scalars ..
 46       CHARACTER*2        C2
 47       INTEGER            I, IHI, ILO, INFO, J, NT, SDIM
 48       REAL               ABNRM
 49 *     ..
 50 *     .. Local Arrays ..
 51       LOGICAL            B( NMAX )
 52       INTEGER            IW( 4*NMAX )
 53       REAL               R1( NMAX ), R2( NMAX ), RW( LW ), S( NMAX )
 54       COMPLEX            A( NMAX, NMAX ), U( NMAX, NMAX ),
 55      $                   VL( NMAX, NMAX ), VR( NMAX, NMAX ),
 56      $                   VT( NMAX, NMAX ), W( 4*NMAX ), X( NMAX )
 57 *     ..
 58 *     .. External Subroutines ..
 59       EXTERNAL           CGEES, CGEESX, CGEEV, CGEEVX, CGESDD, CGESVD,
 60      $                   CHKXER
 61 *     ..
 62 *     .. External Functions ..
 63       LOGICAL            CSLECT, LSAMEN
 64       EXTERNAL           CSLECT, LSAMEN
 65 *     ..
 66 *     .. Intrinsic Functions ..
 67       INTRINSIC          LEN_TRIM
 68 *     ..
 69 *     .. Arrays in Common ..
 70       LOGICAL            SELVAL( 20 )
 71       REAL               SELWI( 20 ), SELWR( 20 )
 72 *     ..
 73 *     .. Scalars in Common ..
 74       LOGICAL            LERR, OK
 75       CHARACTER*32       SRNAMT
 76       INTEGER            INFOT, NOUT, SELDIM, SELOPT
 77 *     ..
 78 *     .. Common blocks ..
 79       COMMON             / INFOC / INFOT, NOUT, OK, LERR
 80       COMMON             / SRNAMC / SRNAMT
 81       COMMON             / SSLCT / SELOPT, SELDIM, SELVAL, SELWR, SELWI
 82 *     ..
 83 *     .. Executable Statements ..
 84 *
 85       NOUT = NUNIT
 86       WRITE( NOUT, FMT = * )
 87       C2 = PATH( 23 )
 88 *
 89 *     Initialize A
 90 *
 91       DO 20 J = 1, NMAX
 92          DO 10 I = 1, NMAX
 93             A( I, J ) = ZERO
 94    10    CONTINUE
 95    20 CONTINUE
 96       DO 30 I = 1, NMAX
 97          A( I, I ) = ONE
 98    30 CONTINUE
 99       OK = .TRUE.
100       NT = 0
101 *
102       IF( LSAMEN( 2, C2, 'EV' ) ) THEN
103 *
104 *        Test CGEEV
105 *
106          SRNAMT = 'CGEEV '
107          INFOT = 1
108          CALL CGEEV( 'X''N'0, A, 1, X, VL, 1, VR, 1, W, 1, RW,
109      $               INFO )
110          CALL CHKXER( 'CGEEV ', INFOT, NOUT, LERR, OK )
111          INFOT = 2
112          CALL CGEEV( 'N''X'0, A, 1, X, VL, 1, VR, 1, W, 1, RW,
113      $               INFO )
114          CALL CHKXER( 'CGEEV ', INFOT, NOUT, LERR, OK )
115          INFOT = 3
116          CALL CGEEV( 'N''N'-1, A, 1, X, VL, 1, VR, 1, W, 1, RW,
117      $               INFO )
118          CALL CHKXER( 'CGEEV ', INFOT, NOUT, LERR, OK )
119          INFOT = 5
120          CALL CGEEV( 'N''N'2, A, 1, X, VL, 1, VR, 1, W, 4, RW,
121      $               INFO )
122          CALL CHKXER( 'CGEEV ', INFOT, NOUT, LERR, OK )
123          INFOT = 8
124          CALL CGEEV( 'V''N'2, A, 2, X, VL, 1, VR, 1, W, 4, RW,
125      $               INFO )
126          CALL CHKXER( 'CGEEV ', INFOT, NOUT, LERR, OK )
127          INFOT = 10
128          CALL CGEEV( 'N''V'2, A, 2, X, VL, 1, VR, 1, W, 4, RW,
129      $               INFO )
130          CALL CHKXER( 'CGEEV ', INFOT, NOUT, LERR, OK )
131          INFOT = 12
132          CALL CGEEV( 'V''V'1, A, 1, X, VL, 1, VR, 1, W, 1, RW,
133      $               INFO )
134          CALL CHKXER( 'CGEEV ', INFOT, NOUT, LERR, OK )
135          NT = NT + 7
136 *
137       ELSE IF( LSAMEN( 2, C2, 'ES' ) ) THEN
138 *
139 *        Test CGEES
140 *
141          SRNAMT = 'CGEES '
142          INFOT = 1
143          CALL CGEES( 'X''N', CSLECT, 0, A, 1, SDIM, X, VL, 1, W, 1,
144      $               RW, B, INFO )
145          CALL CHKXER( 'CGEES ', INFOT, NOUT, LERR, OK )
146          INFOT = 2
147          CALL CGEES( 'N''X', CSLECT, 0, A, 1, SDIM, X, VL, 1, W, 1,
148      $               RW, B, INFO )
149          CALL CHKXER( 'CGEES ', INFOT, NOUT, LERR, OK )
150          INFOT = 4
151          CALL CGEES( 'N''S', CSLECT, -1, A, 1, SDIM, X, VL, 1, W, 1,
152      $               RW, B, INFO )
153          CALL CHKXER( 'CGEES ', INFOT, NOUT, LERR, OK )
154          INFOT = 6
155          CALL CGEES( 'N''S', CSLECT, 2, A, 1, SDIM, X, VL, 1, W, 4,
156      $               RW, B, INFO )
157          CALL CHKXER( 'CGEES ', INFOT, NOUT, LERR, OK )
158          INFOT = 10
159          CALL CGEES( 'V''S', CSLECT, 2, A, 2, SDIM, X, VL, 1, W, 4,
160      $               RW, B, INFO )
161          CALL CHKXER( 'CGEES ', INFOT, NOUT, LERR, OK )
162          INFOT = 12
163          CALL CGEES( 'N''S', CSLECT, 1, A, 1, SDIM, X, VL, 1, W, 1,
164      $               RW, B, INFO )
165          CALL CHKXER( 'CGEES ', INFOT, NOUT, LERR, OK )
166          NT = NT + 6
167 *
168       ELSE IF( LSAMEN( 2, C2, 'VX' ) ) THEN
169 *
170 *        Test CGEEVX
171 *
172          SRNAMT = 'CGEEVX'
173          INFOT = 1
174          CALL CGEEVX( 'X''N''N''N'0, A, 1, X, VL, 1, VR, 1, ILO,
175      $                IHI, S, ABNRM, R1, R2, W, 1, RW, INFO )
176          CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
177          INFOT = 2
178          CALL CGEEVX( 'N''X''N''N'0, A, 1, X, VL, 1, VR, 1, ILO,
179      $                IHI, S, ABNRM, R1, R2, W, 1, RW, INFO )
180          CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
181          INFOT = 3
182          CALL CGEEVX( 'N''N''X''N'0, A, 1, X, VL, 1, VR, 1, ILO,
183      $                IHI, S, ABNRM, R1, R2, W, 1, RW, INFO )
184          CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
185          INFOT = 4
186          CALL CGEEVX( 'N''N''N''X'0, A, 1, X, VL, 1, VR, 1, ILO,
187      $                IHI, S, ABNRM, R1, R2, W, 1, RW, INFO )
188          CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
189          INFOT = 5
190          CALL CGEEVX( 'N''N''N''N'-1, A, 1, X, VL, 1, VR, 1,
191      $                ILO, IHI, S, ABNRM, R1, R2, W, 1, RW, INFO )
192          CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
193          INFOT = 7
194          CALL CGEEVX( 'N''N''N''N'2, A, 1, X, VL, 1, VR, 1, ILO,
195      $                IHI, S, ABNRM, R1, R2, W, 4, RW, INFO )
196          CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
197          INFOT = 10
198          CALL CGEEVX( 'N''V''N''N'2, A, 2, X, VL, 1, VR, 1, ILO,
199      $                IHI, S, ABNRM, R1, R2, W, 4, RW, INFO )
200          CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
201          INFOT = 12
202          CALL CGEEVX( 'N''N''V''N'2, A, 2, X, VL, 1, VR, 1, ILO,
203      $                IHI, S, ABNRM, R1, R2, W, 4, RW, INFO )
204          CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
205          INFOT = 20
206          CALL CGEEVX( 'N''N''N''N'1, A, 1, X, VL, 1, VR, 1, ILO,
207      $                IHI, S, ABNRM, R1, R2, W, 1, RW, INFO )
208          CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
209          INFOT = 20
210          CALL CGEEVX( 'N''N''V''V'1, A, 1, X, VL, 1, VR, 1, ILO,
211      $                IHI, S, ABNRM, R1, R2, W, 2, RW, INFO )
212          CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
213          NT = NT + 10
214 *
215       ELSE IF( LSAMEN( 2, C2, 'SX' ) ) THEN
216 *
217 *        Test CGEESX
218 *
219          SRNAMT = 'CGEESX'
220          INFOT = 1
221          CALL CGEESX( 'X''N', CSLECT, 'N'0, A, 1, SDIM, X, VL, 1,
222      $                R1( 1 ), R2( 1 ), W, 1, RW, B, INFO )
223          CALL CHKXER( 'CGEESX', INFOT, NOUT, LERR, OK )
224          INFOT = 2
225          CALL CGEESX( 'N''X', CSLECT, 'N'0, A, 1, SDIM, X, VL, 1,
226      $                R1( 1 ), R2( 1 ), W, 1, RW, B, INFO )
227          CALL CHKXER( 'CGEESX', INFOT, NOUT, LERR, OK )
228          INFOT = 4
229          CALL CGEESX( 'N''N', CSLECT, 'X'0, A, 1, SDIM, X, VL, 1,
230      $                R1( 1 ), R2( 1 ), W, 1, RW, B, INFO )
231          CALL CHKXER( 'CGEESX', INFOT, NOUT, LERR, OK )
232          INFOT = 5
233          CALL CGEESX( 'N''N', CSLECT, 'N'-1, A, 1, SDIM, X, VL, 1,
234      $                R1( 1 ), R2( 1 ), W, 1, RW, B, INFO )
235          CALL CHKXER( 'CGEESX', INFOT, NOUT, LERR, OK )
236          INFOT = 7
237          CALL CGEESX( 'N''N', CSLECT, 'N'2, A, 1, SDIM, X, VL, 1,
238      $                R1( 1 ), R2( 1 ), W, 4, RW, B, INFO )
239          CALL CHKXER( 'CGEESX', INFOT, NOUT, LERR, OK )
240          INFOT = 11
241          CALL CGEESX( 'V''N', CSLECT, 'N'2, A, 2, SDIM, X, VL, 1,
242      $                R1( 1 ), R2( 1 ), W, 4, RW, B, INFO )
243          CALL CHKXER( 'CGEESX', INFOT, NOUT, LERR, OK )
244          INFOT = 15
245          CALL CGEESX( 'N''N', CSLECT, 'N'1, A, 1, SDIM, X, VL, 1,
246      $                R1( 1 ), R2( 1 ), W, 1, RW, B, INFO )
247          CALL CHKXER( 'CGEESX', INFOT, NOUT, LERR, OK )
248          NT = NT + 7
249 *
250       ELSE IF( LSAMEN( 2, C2, 'BD' ) ) THEN
251 *
252 *        Test CGESVD
253 *
254          SRNAMT = 'CGESVD'
255          INFOT = 1
256          CALL CGESVD( 'X''N'00, A, 1, S, U, 1, VT, 1, W, 1, RW,
257      $                INFO )
258          CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK )
259          INFOT = 2
260          CALL CGESVD( 'N''X'00, A, 1, S, U, 1, VT, 1, W, 1, RW,
261      $                INFO )
262          CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK )
263          INFOT = 2
264          CALL CGESVD( 'O''O'00, A, 1, S, U, 1, VT, 1, W, 1, RW,
265      $                INFO )
266          CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK )
267          INFOT = 3
268          CALL CGESVD( 'N''N'-10, A, 1, S, U, 1, VT, 1, W, 1, RW,
269      $                INFO )
270          CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK )
271          INFOT = 4
272          CALL CGESVD( 'N''N'0-1, A, 1, S, U, 1, VT, 1, W, 1, RW,
273      $                INFO )
274          CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK )
275          INFOT = 6
276          CALL CGESVD( 'N''N'21, A, 1, S, U, 1, VT, 1, W, 5, RW,
277      $                INFO )
278          CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK )
279          INFOT = 9
280          CALL CGESVD( 'A''N'21, A, 2, S, U, 1, VT, 1, W, 5, RW,
281      $                INFO )
282          CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK )
283          INFOT = 11
284          CALL CGESVD( 'N''A'12, A, 1, S, U, 1, VT, 1, W, 5, RW,
285      $                INFO )
286          CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK )
287          NT = NT + 8
288          IF( OK ) THEN
289             WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ),
290      $           NT
291          ELSE
292             WRITE( NOUT, FMT = 9998 )
293          END IF
294 *
295 *        Test CGESDD
296 *
297          SRNAMT = 'CGESDD'
298          INFOT = 1
299          CALL CGESDD( 'X'00, A, 1, S, U, 1, VT, 1, W, 1, RW, IW,
300      $                INFO )
301          CALL CHKXER( 'CGESDD', INFOT, NOUT, LERR, OK )
302          INFOT = 2
303          CALL CGESDD( 'N'-10, A, 1, S, U, 1, VT, 1, W, 1, RW, IW,
304      $                INFO )
305          CALL CHKXER( 'CGESDD', INFOT, NOUT, LERR, OK )
306          INFOT = 3
307          CALL CGESDD( 'N'0-1, A, 1, S, U, 1, VT, 1, W, 1, RW, IW,
308      $                INFO )
309          CALL CHKXER( 'CGESDD', INFOT, NOUT, LERR, OK )
310          INFOT = 5
311          CALL CGESDD( 'N'21, A, 1, S, U, 1, VT, 1, W, 5, RW, IW,
312      $                INFO )
313          CALL CHKXER( 'CGESDD', INFOT, NOUT, LERR, OK )
314          INFOT = 8
315          CALL CGESDD( 'A'21, A, 2, S, U, 1, VT, 1, W, 5, RW, IW,
316      $                INFO )
317          CALL CHKXER( 'CGESDD', INFOT, NOUT, LERR, OK )
318          INFOT = 10
319          CALL CGESDD( 'A'12, A, 1, S, U, 1, VT, 1, W, 5, RW, IW,
320      $                INFO )
321          CALL CHKXER( 'CGESDD', INFOT, NOUT, LERR, OK )
322          NT = NT - 2
323          IF( OK ) THEN
324             WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ),
325      $           NT
326          ELSE
327             WRITE( NOUT, FMT = 9998 )
328          END IF
329       END IF
330 *
331 *     Print a summary line.
332 *
333       IF.NOT.LSAMEN( 2, C2, 'BD' ) ) THEN
334          IF( OK ) THEN
335             WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ),
336      $           NT
337          ELSE
338             WRITE( NOUT, FMT = 9998 )
339          END IF
340       END IF
341 *
342  9999 FORMAT1X, A, ' passed the tests of the error exits (', I3,
343      $      ' tests done)' )
344  9998 FORMAT' *** ', A, ' failed the tests of the error exits ***' )
345       RETURN
346 *
347 *     End of CERRED
348 *
349       END