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