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