1       SUBROUTINE CERRHS( 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 *  CERRHS tests the error exits for CGEBAK, CGEBAL, CGEHRD, CUNGHR,
 16 *  CUNMHR, CHSEQR, CHSEIN, and CTREVC.
 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*NMAX )
 32 *     ..
 33 *     .. Local Scalars ..
 34       CHARACTER*2        C2
 35       INTEGER            I, IHI, ILO, INFO, J, M, NT
 36 *     ..
 37 *     .. Local Arrays ..
 38       LOGICAL            SEL( NMAX )
 39       INTEGER            IFAILL( NMAX ), IFAILR( NMAX )
 40       REAL               RW( NMAX ), S( NMAX )
 41       COMPLEX            A( NMAX, NMAX ), C( NMAX, NMAX ), TAU( NMAX ),
 42      $                   VL( NMAX, NMAX ), VR( NMAX, NMAX ), W( LW ),
 43      $                   X( NMAX )
 44 *     ..
 45 *     .. External Functions ..
 46       LOGICAL            LSAMEN
 47       EXTERNAL           LSAMEN
 48 *     ..
 49 *     .. External Subroutines ..
 50       EXTERNAL           CHKXER, CGEBAK, CGEBAL, CGEHRD, CHSEIN, CHSEQR,
 51      $                   CUNGHR, CUNMHR, CTREVC
 52 *     ..
 53 *     .. Intrinsic Functions ..
 54       INTRINSIC          REAL
 55 *     ..
 56 *     .. Scalars in Common ..
 57       LOGICAL            LERR, OK
 58       CHARACTER*32       SRNAMT
 59       INTEGER            INFOT, NOUT
 60 *     ..
 61 *     .. Common blocks ..
 62       COMMON             / INFOC / INFOT, NOUT, OK, LERR
 63       COMMON             / SRNAMC / SRNAMT
 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 ) = 1/ REAL( I+J )
 76    10    CONTINUE
 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 *        CGEBAL
 87 *
 88          SRNAMT = 'CGEBAL'
 89          INFOT = 1
 90          CALL CGEBAL( '/'0, A, 1, ILO, IHI, S, INFO )
 91          CALL CHKXER( 'CGEBAL', INFOT, NOUT, LERR, OK )
 92          INFOT = 2
 93          CALL CGEBAL( 'N'-1, A, 1, ILO, IHI, S, INFO )
 94          CALL CHKXER( 'CGEBAL', INFOT, NOUT, LERR, OK )
 95          INFOT = 4
 96          CALL CGEBAL( 'N'2, A, 1, ILO, IHI, S, INFO )
 97          CALL CHKXER( 'CGEBAL', INFOT, NOUT, LERR, OK )
 98          NT = NT + 3
 99 *
100 *        CGEBAK
101 *
102          SRNAMT = 'CGEBAK'
103          INFOT = 1
104          CALL CGEBAK( '/''R'010, S, 0, A, 1, INFO )
105          CALL CHKXER( 'CGEBAK', INFOT, NOUT, LERR, OK )
106          INFOT = 2
107          CALL CGEBAK( 'N''/'010, S, 0, A, 1, INFO )
108          CALL CHKXER( 'CGEBAK', INFOT, NOUT, LERR, OK )
109          INFOT = 3
110          CALL CGEBAK( 'N''R'-110, S, 0, A, 1, INFO )
111          CALL CHKXER( 'CGEBAK', INFOT, NOUT, LERR, OK )
112          INFOT = 4
113          CALL CGEBAK( 'N''R'000, S, 0, A, 1, INFO )
114          CALL CHKXER( 'CGEBAK', INFOT, NOUT, LERR, OK )
115          INFOT = 4
116          CALL CGEBAK( 'N''R'020, S, 0, A, 1, INFO )
117          CALL CHKXER( 'CGEBAK', INFOT, NOUT, LERR, OK )
118          INFOT = 5
119          CALL CGEBAK( 'N''R'221, S, 0, A, 2, INFO )
120          CALL CHKXER( 'CGEBAK', INFOT, NOUT, LERR, OK )
121          INFOT = 5
122          CALL CGEBAK( 'N''R'011, S, 0, A, 1, INFO )
123          CALL CHKXER( 'CGEBAK', INFOT, NOUT, LERR, OK )
124          INFOT = 7
125          CALL CGEBAK( 'N''R'010, S, -1, A, 1, INFO )
126          CALL CHKXER( 'CGEBAK', INFOT, NOUT, LERR, OK )
127          INFOT = 9
128          CALL CGEBAK( 'N''R'212, S, 0, A, 1, INFO )
129          CALL CHKXER( 'CGEBAK', INFOT, NOUT, LERR, OK )
130          NT = NT + 9
131 *
132 *        CGEHRD
133 *
134          SRNAMT = 'CGEHRD'
135          INFOT = 1
136          CALL CGEHRD( -111, A, 1, TAU, W, 1, INFO )
137          CALL CHKXER( 'CGEHRD', INFOT, NOUT, LERR, OK )
138          INFOT = 2
139          CALL CGEHRD( 000, A, 1, TAU, W, 1, INFO )
140          CALL CHKXER( 'CGEHRD', INFOT, NOUT, LERR, OK )
141          INFOT = 2
142          CALL CGEHRD( 020, A, 1, TAU, W, 1, INFO )
143          CALL CHKXER( 'CGEHRD', INFOT, NOUT, LERR, OK )
144          INFOT = 3
145          CALL CGEHRD( 110, A, 1, TAU, W, 1, INFO )
146          CALL CHKXER( 'CGEHRD', INFOT, NOUT, LERR, OK )
147          INFOT = 3
148          CALL CGEHRD( 011, A, 1, TAU, W, 1, INFO )
149          CALL CHKXER( 'CGEHRD', INFOT, NOUT, LERR, OK )
150          INFOT = 5
151          CALL CGEHRD( 211, A, 1, TAU, W, 2, INFO )
152          CALL CHKXER( 'CGEHRD', INFOT, NOUT, LERR, OK )
153          INFOT = 8
154          CALL CGEHRD( 212, A, 2, TAU, W, 1, INFO )
155          CALL CHKXER( 'CGEHRD', INFOT, NOUT, LERR, OK )
156          NT = NT + 7
157 *
158 *        CUNGHR
159 *
160          SRNAMT = 'CUNGHR'
161          INFOT = 1
162          CALL CUNGHR( -111, A, 1, TAU, W, 1, INFO )
163          CALL CHKXER( 'CUNGHR', INFOT, NOUT, LERR, OK )
164          INFOT = 2
165          CALL CUNGHR( 000, A, 1, TAU, W, 1, INFO )
166          CALL CHKXER( 'CUNGHR', INFOT, NOUT, LERR, OK )
167          INFOT = 2
168          CALL CUNGHR( 020, A, 1, TAU, W, 1, INFO )
169          CALL CHKXER( 'CUNGHR', INFOT, NOUT, LERR, OK )
170          INFOT = 3
171          CALL CUNGHR( 110, A, 1, TAU, W, 1, INFO )
172          CALL CHKXER( 'CUNGHR', INFOT, NOUT, LERR, OK )
173          INFOT = 3
174          CALL CUNGHR( 011, A, 1, TAU, W, 1, INFO )
175          CALL CHKXER( 'CUNGHR', INFOT, NOUT, LERR, OK )
176          INFOT = 5
177          CALL CUNGHR( 211, A, 1, TAU, W, 1, INFO )
178          CALL CHKXER( 'CUNGHR', INFOT, NOUT, LERR, OK )
179          INFOT = 8
180          CALL CUNGHR( 313, A, 3, TAU, W, 1, INFO )
181          CALL CHKXER( 'CUNGHR', INFOT, NOUT, LERR, OK )
182          NT = NT + 7
183 *
184 *        CUNMHR
185 *
186          SRNAMT = 'CUNMHR'
187          INFOT = 1
188          CALL CUNMHR( '/''N'0010, A, 1, TAU, C, 1, W, 1,
189      $                INFO )
190          CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK )
191          INFOT = 2
192          CALL CUNMHR( 'L''/'0010, A, 1, TAU, C, 1, W, 1,
193      $                INFO )
194          CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK )
195          INFOT = 3
196          CALL CUNMHR( 'L''N'-1010, A, 1, TAU, C, 1, W, 1,
197      $                INFO )
198          CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK )
199          INFOT = 4
200          CALL CUNMHR( 'L''N'0-110, A, 1, TAU, C, 1, W, 1,
201      $                INFO )
202          CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK )
203          INFOT = 5
204          CALL CUNMHR( 'L''N'0000, A, 1, TAU, C, 1, W, 1,
205      $                INFO )
206          CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK )
207          INFOT = 5
208          CALL CUNMHR( 'L''N'0020, A, 1, TAU, C, 1, W, 1,
209      $                INFO )
210          CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK )
211          INFOT = 5
212          CALL CUNMHR( 'L''N'1221, A, 1, TAU, C, 1, W, 2,
213      $                INFO )
214          CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK )
215          INFOT = 5
216          CALL CUNMHR( 'R''N'2121, A, 1, TAU, C, 2, W, 2,
217      $                INFO )
218          CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK )
219          INFOT = 6
220          CALL CUNMHR( 'L''N'1110, A, 1, TAU, C, 1, W, 1,
221      $                INFO )
222          CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK )
223          INFOT = 6
224          CALL CUNMHR( 'L''N'0111, A, 1, TAU, C, 1, W, 1,
225      $                INFO )
226          CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK )
227          INFOT = 6
228          CALL CUNMHR( 'R''N'1011, A, 1, TAU, C, 1, W, 1,
229      $                INFO )
230          CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK )
231          INFOT = 8
232          CALL CUNMHR( 'L''N'2111, A, 1, TAU, C, 2, W, 1,
233      $                INFO )
234          CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK )
235          INFOT = 8
236          CALL CUNMHR( 'R''N'1211, A, 1, TAU, C, 1, W, 1,
237      $                INFO )
238          CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK )
239          INFOT = 11
240          CALL CUNMHR( 'L''N'2111, A, 2, TAU, C, 1, W, 1,
241      $                INFO )
242          CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK )
243          INFOT = 13
244          CALL CUNMHR( 'L''N'1211, A, 1, TAU, C, 1, W, 1,
245      $                INFO )
246          CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK )
247          INFOT = 13
248          CALL CUNMHR( 'R''N'2111, A, 1, TAU, C, 2, W, 1,
249      $                INFO )
250          CALL CHKXER( 'CUNMHR', INFOT, NOUT, LERR, OK )
251          NT = NT + 16
252 *
253 *        CHSEQR
254 *
255          SRNAMT = 'CHSEQR'
256          INFOT = 1
257          CALL CHSEQR( '/''N'010, A, 1, X, C, 1, W, 1,
258      $                INFO )
259          CALL CHKXER( 'CHSEQR', INFOT, NOUT, LERR, OK )
260          INFOT = 2
261          CALL CHSEQR( 'E''/'010, A, 1, X, C, 1, W, 1,
262      $                INFO )
263          CALL CHKXER( 'CHSEQR', INFOT, NOUT, LERR, OK )
264          INFOT = 3
265          CALL CHSEQR( 'E''N'-110, A, 1, X, C, 1, W, 1,
266      $                INFO )
267          CALL CHKXER( 'CHSEQR', INFOT, NOUT, LERR, OK )
268          INFOT = 4
269          CALL CHSEQR( 'E''N'000, A, 1, X, C, 1, W, 1,
270      $                INFO )
271          CALL CHKXER( 'CHSEQR', INFOT, NOUT, LERR, OK )
272          INFOT = 4
273          CALL CHSEQR( 'E''N'020, A, 1, X, C, 1, W, 1,
274      $                INFO )
275          CALL CHKXER( 'CHSEQR', INFOT, NOUT, LERR, OK )
276          INFOT = 5
277          CALL CHSEQR( 'E''N'110, A, 1, X, C, 1, W, 1,
278      $                INFO )
279          CALL CHKXER( 'CHSEQR', INFOT, NOUT, LERR, OK )
280          INFOT = 5
281          CALL CHSEQR( 'E''N'112, A, 1, X, C, 1, W, 1,
282      $                INFO )
283          CALL CHKXER( 'CHSEQR', INFOT, NOUT, LERR, OK )
284          INFOT = 7
285          CALL CHSEQR( 'E''N'212, A, 1, X, C, 2, W, 1,
286      $                INFO )
287          CALL CHKXER( 'CHSEQR', INFOT, NOUT, LERR, OK )
288          INFOT = 10
289          CALL CHSEQR( 'E''V'212, A, 2, X, C, 1, W, 1,
290      $                INFO )
291          CALL CHKXER( 'CHSEQR', INFOT, NOUT, LERR, OK )
292          NT = NT + 9
293 *
294 *        CHSEIN
295 *
296          SRNAMT = 'CHSEIN'
297          INFOT = 1
298          CALL CHSEIN( '/''N''N', SEL, 0, A, 1, X, VL, 1, VR, 1,
299      $                0, M, W, RW, IFAILL, IFAILR, INFO )
300          CALL CHKXER( 'CHSEIN', INFOT, NOUT, LERR, OK )
301          INFOT = 2
302          CALL CHSEIN( 'R''/''N', SEL, 0, A, 1, X, VL, 1, VR, 1,
303      $                0, M, W, RW, IFAILL, IFAILR, INFO )
304          CALL CHKXER( 'CHSEIN', INFOT, NOUT, LERR, OK )
305          INFOT = 3
306          CALL CHSEIN( 'R''N''/', SEL, 0, A, 1, X, VL, 1, VR, 1,
307      $                0, M, W, RW, IFAILL, IFAILR, INFO )
308          CALL CHKXER( 'CHSEIN', INFOT, NOUT, LERR, OK )
309          INFOT = 5
310          CALL CHSEIN( 'R''N''N', SEL, -1, A, 1, X, VL, 1, VR,
311      $                10, M, W, RW, IFAILL, IFAILR, INFO )
312          CALL CHKXER( 'CHSEIN', INFOT, NOUT, LERR, OK )
313          INFOT = 7
314          CALL CHSEIN( 'R''N''N', SEL, 2, A, 1, X, VL, 1, VR, 2,
315      $                4, M, W, RW, IFAILL, IFAILR, INFO )
316          CALL CHKXER( 'CHSEIN', INFOT, NOUT, LERR, OK )
317          INFOT = 10
318          CALL CHSEIN( 'L''N''N', SEL, 2, A, 2, X, VL, 1, VR, 1,
319      $                4, M, W, RW, IFAILL, IFAILR, INFO )
320          CALL CHKXER( 'CHSEIN', INFOT, NOUT, LERR, OK )
321          INFOT = 12
322          CALL CHSEIN( 'R''N''N', SEL, 2, A, 2, X, VL, 1, VR, 1,
323      $                4, M, W, RW, IFAILL, IFAILR, INFO )
324          CALL CHKXER( 'CHSEIN', INFOT, NOUT, LERR, OK )
325          INFOT = 13
326          CALL CHSEIN( 'R''N''N', SEL, 2, A, 2, X, VL, 1, VR, 2,
327      $                1, M, W, RW, IFAILL, IFAILR, INFO )
328          CALL CHKXER( 'CHSEIN', INFOT, NOUT, LERR, OK )
329          NT = NT + 8
330 *
331 *        CTREVC
332 *
333          SRNAMT = 'CTREVC'
334          INFOT = 1
335          CALL CTREVC( '/''A', SEL, 0, A, 1, VL, 1, VR, 10, M, W,
336      $                RW, INFO )
337          CALL CHKXER( 'CTREVC', INFOT, NOUT, LERR, OK )
338          INFOT = 2
339          CALL CTREVC( 'L''/', SEL, 0, A, 1, VL, 1, VR, 10, M, W,
340      $                RW, INFO )
341          CALL CHKXER( 'CTREVC', INFOT, NOUT, LERR, OK )
342          INFOT = 4
343          CALL CTREVC( 'L''A', SEL, -1, A, 1, VL, 1, VR, 10, M, W,
344      $                RW, INFO )
345          CALL CHKXER( 'CTREVC', INFOT, NOUT, LERR, OK )
346          INFOT = 6
347          CALL CTREVC( 'L''A', SEL, 2, A, 1, VL, 2, VR, 14, M, W,
348      $                RW, INFO )
349          CALL CHKXER( 'CTREVC', INFOT, NOUT, LERR, OK )
350          INFOT = 8
351          CALL CTREVC( 'L''A', SEL, 2, A, 2, VL, 1, VR, 14, M, W,
352      $                RW, INFO )
353          CALL CHKXER( 'CTREVC', INFOT, NOUT, LERR, OK )
354          INFOT = 10
355          CALL CTREVC( 'R''A', SEL, 2, A, 2, VL, 1, VR, 14, M, W,
356      $                RW, INFO )
357          CALL CHKXER( 'CTREVC', INFOT, NOUT, LERR, OK )
358          INFOT = 11
359          CALL CTREVC( 'L''A', SEL, 2, A, 2, VL, 2, VR, 11, M, W,
360      $                RW, INFO )
361          CALL CHKXER( 'CTREVC', 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 CERRHS
381 *
382       END