1       SUBROUTINE SERRHS( 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 *  SERRHS tests the error exits for SGEBAK, SGEBAL, SGEHRD, SORGHR,
 16 *  SORMHR, SHSEQR, SHSEIN, and STREVC.
 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, LW
 31       PARAMETER          ( NMAX = 3, LW = ( NMAX+2 )*( NMAX+2 )+NMAX )
 32 *     ..
 33 *     .. Local Scalars ..
 34       CHARACTER*2        C2
 35       INTEGER            I, ILO, IHI, INFO, J, M, NT
 36 *     ..
 37 *     .. Local Arrays ..
 38       LOGICAL            SEL( NMAX )
 39       INTEGER            IFAILL( NMAX ), IFAILR( NMAX )
 40       REAL               A( NMAX, NMAX ), C( NMAX, NMAX ), TAU( NMAX ),
 41      $                   VL( NMAX, NMAX ), VR( NMAX, NMAX ), W( LW ),
 42      $                   WI( NMAX ), WR( NMAX ), S( NMAX )
 43 *     ..
 44 *     .. External Functions ..
 45       LOGICAL            LSAMEN
 46       EXTERNAL           LSAMEN
 47 *     ..
 48 *     .. External Subroutines ..
 49       EXTERNAL           CHKXER, SGEBAK, SGEBAL, SGEHRD, SHSEIN, SHSEQR,
 50      $                   SORGHR, SORMHR, STREVC
 51 *     ..
 52 *     .. Intrinsic Functions ..
 53       INTRINSIC          REAL
 54 *     ..
 55 *     .. Scalars in Common ..
 56       LOGICAL            LERR, OK
 57       CHARACTER*32       SRNAMT
 58       INTEGER            INFOT, NOUT
 59 *     ..
 60 *     .. Common blocks ..
 61       COMMON             / INFOC / INFOT, NOUT, OK, LERR
 62       COMMON             / SRNAMC / SRNAMT
 63 *     ..
 64 *     .. Executable Statements ..
 65 *
 66       NOUT = NUNIT
 67       WRITE( NOUT, FMT = * )
 68       C2 = PATH( 23 )
 69 *
 70 *     Set the variables to innocuous values.
 71 *
 72       DO 20 J = 1, NMAX
 73          DO 10 I = 1, NMAX
 74             A( I, J ) = 1/ REAL( I+J )
 75    10    CONTINUE
 76          WI( J ) = REAL( J )
 77          SEL( J ) = .TRUE.
 78    20 CONTINUE
 79       OK = .TRUE.
 80       NT = 0
 81 *
 82 *     Test error exits of the nonsymmetric eigenvalue routines.
 83 *
 84       IF( LSAMEN( 2, C2, 'HS' ) ) THEN
 85 *
 86 *        SGEBAL
 87 *
 88          SRNAMT = 'SGEBAL'
 89          INFOT = 1
 90          CALL SGEBAL( '/'0, A, 1, ILO, IHI, S, INFO )
 91          CALL CHKXER( 'SGEBAL', INFOT, NOUT, LERR, OK )
 92          INFOT = 2
 93          CALL SGEBAL( 'N'-1, A, 1, ILO, IHI, S, INFO )
 94          CALL CHKXER( 'SGEBAL', INFOT, NOUT, LERR, OK )
 95          INFOT = 4
 96          CALL SGEBAL( 'N'2, A, 1, ILO, IHI, S, INFO )
 97          CALL CHKXER( 'SGEBAL', INFOT, NOUT, LERR, OK )
 98          NT = NT + 3
 99 *
100 *        SGEBAK
101 *
102          SRNAMT = 'SGEBAK'
103          INFOT = 1
104          CALL SGEBAK( '/''R'010, S, 0, A, 1, INFO )
105          CALL CHKXER( 'SGEBAK', INFOT, NOUT, LERR, OK )
106          INFOT = 2
107          CALL SGEBAK( 'N''/'010, S, 0, A, 1, INFO )
108          CALL CHKXER( 'SGEBAK', INFOT, NOUT, LERR, OK )
109          INFOT = 3
110          CALL SGEBAK( 'N''R'-110, S, 0, A, 1, INFO )
111          CALL CHKXER( 'SGEBAK', INFOT, NOUT, LERR, OK )
112          INFOT = 4
113          CALL SGEBAK( 'N''R'000, S, 0, A, 1, INFO )
114          CALL CHKXER( 'SGEBAK', INFOT, NOUT, LERR, OK )
115          INFOT = 4
116          CALL SGEBAK( 'N''R'020, S, 0, A, 1, INFO )
117          CALL CHKXER( 'SGEBAK', INFOT, NOUT, LERR, OK )
118          INFOT = 5
119          CALL SGEBAK( 'N''R'221, S, 0, A, 2, INFO )
120          CALL CHKXER( 'SGEBAK', INFOT, NOUT, LERR, OK )
121          INFOT = 5
122          CALL SGEBAK( 'N''R'011, S, 0, A, 1, INFO )
123          CALL CHKXER( 'SGEBAK', INFOT, NOUT, LERR, OK )
124          INFOT = 7
125          CALL SGEBAK( 'N''R'010, S, -1, A, 1, INFO )
126          CALL CHKXER( 'SGEBAK', INFOT, NOUT, LERR, OK )
127          INFOT = 9
128          CALL SGEBAK( 'N''R'212, S, 0, A, 1, INFO )
129          CALL CHKXER( 'SGEBAK', INFOT, NOUT, LERR, OK )
130          NT = NT + 9
131 *
132 *        SGEHRD
133 *
134          SRNAMT = 'SGEHRD'
135          INFOT = 1
136          CALL SGEHRD( -111, A, 1, TAU, W, 1, INFO )
137          CALL CHKXER( 'SGEHRD', INFOT, NOUT, LERR, OK )
138          INFOT = 2
139          CALL SGEHRD( 000, A, 1, TAU, W, 1, INFO )
140          CALL CHKXER( 'SGEHRD', INFOT, NOUT, LERR, OK )
141          INFOT = 2
142          CALL SGEHRD( 020, A, 1, TAU, W, 1, INFO )
143          CALL CHKXER( 'SGEHRD', INFOT, NOUT, LERR, OK )
144          INFOT = 3
145          CALL SGEHRD( 110, A, 1, TAU, W, 1, INFO )
146          CALL CHKXER( 'SGEHRD', INFOT, NOUT, LERR, OK )
147          INFOT = 3
148          CALL SGEHRD( 011, A, 1, TAU, W, 1, INFO )
149          CALL CHKXER( 'SGEHRD', INFOT, NOUT, LERR, OK )
150          INFOT = 5
151          CALL SGEHRD( 211, A, 1, TAU, W, 2, INFO )
152          CALL CHKXER( 'SGEHRD', INFOT, NOUT, LERR, OK )
153          INFOT = 8
154          CALL SGEHRD( 212, A, 2, TAU, W, 1, INFO )
155          CALL CHKXER( 'SGEHRD', INFOT, NOUT, LERR, OK )
156          NT = NT + 7
157 *
158 *        SORGHR
159 *
160          SRNAMT = 'SORGHR'
161          INFOT = 1
162          CALL SORGHR( -111, A, 1, TAU, W, 1, INFO )
163          CALL CHKXER( 'SORGHR', INFOT, NOUT, LERR, OK )
164          INFOT = 2
165          CALL SORGHR( 000, A, 1, TAU, W, 1, INFO )
166          CALL CHKXER( 'SORGHR', INFOT, NOUT, LERR, OK )
167          INFOT = 2
168          CALL SORGHR( 020, A, 1, TAU, W, 1, INFO )
169          CALL CHKXER( 'SORGHR', INFOT, NOUT, LERR, OK )
170          INFOT = 3
171          CALL SORGHR( 110, A, 1, TAU, W, 1, INFO )
172          CALL CHKXER( 'SORGHR', INFOT, NOUT, LERR, OK )
173          INFOT = 3
174          CALL SORGHR( 011, A, 1, TAU, W, 1, INFO )
175          CALL CHKXER( 'SORGHR', INFOT, NOUT, LERR, OK )
176          INFOT = 5
177          CALL SORGHR( 211, A, 1, TAU, W, 1, INFO )
178          CALL CHKXER( 'SORGHR', INFOT, NOUT, LERR, OK )
179          INFOT = 8
180          CALL SORGHR( 313, A, 3, TAU, W, 1, INFO )
181          CALL CHKXER( 'SORGHR', INFOT, NOUT, LERR, OK )
182          NT = NT + 7
183 *
184 *        SORMHR
185 *
186          SRNAMT = 'SORMHR'
187          INFOT = 1
188          CALL SORMHR( '/''N'0010, A, 1, TAU, C, 1, W, 1,
189      $                INFO )
190          CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
191          INFOT = 2
192          CALL SORMHR( 'L''/'0010, A, 1, TAU, C, 1, W, 1,
193      $                INFO )
194          CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
195          INFOT = 3
196          CALL SORMHR( 'L''N'-1010, A, 1, TAU, C, 1, W, 1,
197      $                INFO )
198          CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
199          INFOT = 4
200          CALL SORMHR( 'L''N'0-110, A, 1, TAU, C, 1, W, 1,
201      $                INFO )
202          CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
203          INFOT = 5
204          CALL SORMHR( 'L''N'0000, A, 1, TAU, C, 1, W, 1,
205      $                INFO )
206          CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
207          INFOT = 5
208          CALL SORMHR( 'L''N'0020, A, 1, TAU, C, 1, W, 1,
209      $                INFO )
210          CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
211          INFOT = 5
212          CALL SORMHR( 'L''N'1221, A, 1, TAU, C, 1, W, 2,
213      $                INFO )
214          CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
215          INFOT = 5
216          CALL SORMHR( 'R''N'2121, A, 1, TAU, C, 2, W, 2,
217      $                INFO )
218          CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
219          INFOT = 6
220          CALL SORMHR( 'L''N'1110, A, 1, TAU, C, 1, W, 1,
221      $                INFO )
222          CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
223          INFOT = 6
224          CALL SORMHR( 'L''N'0111, A, 1, TAU, C, 1, W, 1,
225      $                INFO )
226          CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
227          INFOT = 6
228          CALL SORMHR( 'R''N'1011, A, 1, TAU, C, 1, W, 1,
229      $                INFO )
230          CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
231          INFOT = 8
232          CALL SORMHR( 'L''N'2111, A, 1, TAU, C, 2, W, 1,
233      $                INFO )
234          CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
235          INFOT = 8
236          CALL SORMHR( 'R''N'1211, A, 1, TAU, C, 1, W, 1,
237      $                INFO )
238          CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
239          INFOT = 11
240          CALL SORMHR( 'L''N'2111, A, 2, TAU, C, 1, W, 1,
241      $                INFO )
242          CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
243          INFOT = 13
244          CALL SORMHR( 'L''N'1211, A, 1, TAU, C, 1, W, 1,
245      $                INFO )
246          CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
247          INFOT = 13
248          CALL SORMHR( 'R''N'2111, A, 1, TAU, C, 2, W, 1,
249      $                INFO )
250          CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
251          NT = NT + 16
252 *
253 *        SHSEQR
254 *
255          SRNAMT = 'SHSEQR'
256          INFOT = 1
257          CALL SHSEQR( '/''N'010, A, 1, WR, WI, C, 1, W, 1,
258      $                INFO )
259          CALL CHKXER( 'SHSEQR', INFOT, NOUT, LERR, OK )
260          INFOT = 2
261          CALL SHSEQR( 'E''/'010, A, 1, WR, WI, C, 1, W, 1,
262      $                INFO )
263          CALL CHKXER( 'SHSEQR', INFOT, NOUT, LERR, OK )
264          INFOT = 3
265          CALL SHSEQR( 'E''N'-110, A, 1, WR, WI, C, 1, W, 1,
266      $                INFO )
267          CALL CHKXER( 'SHSEQR', INFOT, NOUT, LERR, OK )
268          INFOT = 4
269          CALL SHSEQR( 'E''N'000, A, 1, WR, WI, C, 1, W, 1,
270      $                INFO )
271          CALL CHKXER( 'SHSEQR', INFOT, NOUT, LERR, OK )
272          INFOT = 4
273          CALL SHSEQR( 'E''N'020, A, 1, WR, WI, C, 1, W, 1,
274      $                INFO )
275          CALL CHKXER( 'SHSEQR', INFOT, NOUT, LERR, OK )
276          INFOT = 5
277          CALL SHSEQR( 'E''N'110, A, 1, WR, WI, C, 1, W, 1,
278      $                INFO )
279          CALL CHKXER( 'SHSEQR', INFOT, NOUT, LERR, OK )
280          INFOT = 5
281          CALL SHSEQR( 'E''N'112, A, 1, WR, WI, C, 1, W, 1,
282      $                INFO )
283          CALL CHKXER( 'SHSEQR', INFOT, NOUT, LERR, OK )
284          INFOT = 7
285          CALL SHSEQR( 'E''N'212, A, 1, WR, WI, C, 2, W, 1,
286      $                INFO )
287          CALL CHKXER( 'SHSEQR', INFOT, NOUT, LERR, OK )
288          INFOT = 11
289          CALL SHSEQR( 'E''V'212, A, 2, WR, WI, C, 1, W, 1,
290      $                INFO )
291          CALL CHKXER( 'SHSEQR', INFOT, NOUT, LERR, OK )
292          NT = NT + 9
293 *
294 *        SHSEIN
295 *
296          SRNAMT = 'SHSEIN'
297          INFOT = 1
298          CALL SHSEIN( '/''N''N', SEL, 0, A, 1, WR, WI, VL, 1, VR, 1,
299      $                0, M, W, IFAILL, IFAILR, INFO )
300          CALL CHKXER( 'SHSEIN', INFOT, NOUT, LERR, OK )
301          INFOT = 2
302          CALL SHSEIN( 'R''/''N', SEL, 0, A, 1, WR, WI, VL, 1, VR, 1,
303      $                0, M, W, IFAILL, IFAILR, INFO )
304          CALL CHKXER( 'SHSEIN', INFOT, NOUT, LERR, OK )
305          INFOT = 3
306          CALL SHSEIN( 'R''N''/', SEL, 0, A, 1, WR, WI, VL, 1, VR, 1,
307      $                0, M, W, IFAILL, IFAILR, INFO )
308          CALL CHKXER( 'SHSEIN', INFOT, NOUT, LERR, OK )
309          INFOT = 5
310          CALL SHSEIN( 'R''N''N', SEL, -1, A, 1, WR, WI, VL, 1, VR,
311      $                10, M, W, IFAILL, IFAILR, INFO )
312          CALL CHKXER( 'SHSEIN', INFOT, NOUT, LERR, OK )
313          INFOT = 7
314          CALL SHSEIN( 'R''N''N', SEL, 2, A, 1, WR, WI, VL, 1, VR, 2,
315      $                4, M, W, IFAILL, IFAILR, INFO )
316          CALL CHKXER( 'SHSEIN', INFOT, NOUT, LERR, OK )
317          INFOT = 11
318          CALL SHSEIN( 'L''N''N', SEL, 2, A, 2, WR, WI, VL, 1, VR, 1,
319      $                4, M, W, IFAILL, IFAILR, INFO )
320          CALL CHKXER( 'SHSEIN', INFOT, NOUT, LERR, OK )
321          INFOT = 13
322          CALL SHSEIN( 'R''N''N', SEL, 2, A, 2, WR, WI, VL, 1, VR, 1,
323      $                4, M, W, IFAILL, IFAILR, INFO )
324          CALL CHKXER( 'SHSEIN', INFOT, NOUT, LERR, OK )
325          INFOT = 14
326          CALL SHSEIN( 'R''N''N', SEL, 2, A, 2, WR, WI, VL, 1, VR, 2,
327      $                1, M, W, IFAILL, IFAILR, INFO )
328          CALL CHKXER( 'SHSEIN', INFOT, NOUT, LERR, OK )
329          NT = NT + 8
330 *
331 *        STREVC
332 *
333          SRNAMT = 'STREVC'
334          INFOT = 1
335          CALL STREVC( '/''A', SEL, 0, A, 1, VL, 1, VR, 10, M, W,
336      $                INFO )
337          CALL CHKXER( 'STREVC', INFOT, NOUT, LERR, OK )
338          INFOT = 2
339          CALL STREVC( 'L''/', SEL, 0, A, 1, VL, 1, VR, 10, M, W,
340      $                INFO )
341          CALL CHKXER( 'STREVC', INFOT, NOUT, LERR, OK )
342          INFOT = 4
343          CALL STREVC( 'L''A', SEL, -1, A, 1, VL, 1, VR, 10, M, W,
344      $                INFO )
345          CALL CHKXER( 'STREVC', INFOT, NOUT, LERR, OK )
346          INFOT = 6
347          CALL STREVC( 'L''A', SEL, 2, A, 1, VL, 2, VR, 14, M, W,
348      $                INFO )
349          CALL CHKXER( 'STREVC', INFOT, NOUT, LERR, OK )
350          INFOT = 8
351          CALL STREVC( 'L''A', SEL, 2, A, 2, VL, 1, VR, 14, M, W,
352      $                INFO )
353          CALL CHKXER( 'STREVC', INFOT, NOUT, LERR, OK )
354          INFOT = 10
355          CALL STREVC( 'R''A', SEL, 2, A, 2, VL, 1, VR, 14, M, W,
356      $                INFO )
357          CALL CHKXER( 'STREVC', INFOT, NOUT, LERR, OK )
358          INFOT = 11
359          CALL STREVC( 'L''A', SEL, 2, A, 2, VL, 2, VR, 11, M, W,
360      $                INFO )
361          CALL CHKXER( 'STREVC', INFOT, NOUT, LERR, OK )
362          NT = NT + 7
363       END IF
364 *
365 *     Print a summary line.
366 *
367       IF( OK ) THEN
368          WRITE( NOUT, FMT = 9999 )PATH, NT
369       ELSE
370          WRITE( NOUT, FMT = 9998 )PATH
371       END IF
372 *
373  9999 FORMAT1X, A3, ' routines passed the tests of the error exits',
374      $        ' (', I3, ' tests done)' )
375  9998 FORMAT' *** ', A3, ' routines failed the tests of the error ',
376      $      'exits ***' )
377 *
378       RETURN
379 *
380 *     End of SERRHS
381 *
382       END