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