1*> \brief \b SERRHS
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*  Definition:
9*  ===========
10*
11*       SUBROUTINE SERRHS( PATH, NUNIT )
12*
13*       .. Scalar Arguments ..
14*       CHARACTER*3        PATH
15*       INTEGER            NUNIT
16*       ..
17*
18*
19*> \par Purpose:
20*  =============
21*>
22*> \verbatim
23*>
24*> SERRHS tests the error exits for SGEBAK, SGEBAL, SGEHRD, SORGHR,
25*> SORMHR, SHSEQR, SHSEIN, and STREVC.
26*> \endverbatim
27*
28*  Arguments:
29*  ==========
30*
31*> \param[in] PATH
32*> \verbatim
33*>          PATH is CHARACTER*3
34*>          The LAPACK path name for the routines to be tested.
35*> \endverbatim
36*>
37*> \param[in] NUNIT
38*> \verbatim
39*>          NUNIT is INTEGER
40*>          The unit number for output.
41*> \endverbatim
42*
43*  Authors:
44*  ========
45*
46*> \author Univ. of Tennessee
47*> \author Univ. of California Berkeley
48*> \author Univ. of Colorado Denver
49*> \author NAG Ltd.
50*
51*> \ingroup single_eig
52*
53*  =====================================================================
54      SUBROUTINE SERRHS( PATH, NUNIT )
55*
56*  -- LAPACK test routine --
57*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
58*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
59*
60*     .. Scalar Arguments ..
61      CHARACTER*3        PATH
62      INTEGER            NUNIT
63*     ..
64*
65*  =====================================================================
66*
67*     .. Parameters ..
68      INTEGER            NMAX, LW
69      PARAMETER          ( NMAX = 3, LW = ( NMAX+2 )*( NMAX+2 )+NMAX )
70*     ..
71*     .. Local Scalars ..
72      CHARACTER*2        C2
73      INTEGER            I, ILO, IHI, INFO, J, M, NT
74*     ..
75*     .. Local Arrays ..
76      LOGICAL            SEL( NMAX )
77      INTEGER            IFAILL( NMAX ), IFAILR( NMAX )
78      REAL               A( NMAX, NMAX ), C( NMAX, NMAX ), TAU( NMAX ),
79     $                   VL( NMAX, NMAX ), VR( NMAX, NMAX ), W( LW ),
80     $                   WI( NMAX ), WR( NMAX ), S( NMAX )
81*     ..
82*     .. External Functions ..
83      LOGICAL            LSAMEN
84      EXTERNAL           LSAMEN
85*     ..
86*     .. External Subroutines ..
87      EXTERNAL           CHKXER, SGEBAK, SGEBAL, SGEHRD, SHSEIN, SHSEQR,
88     $                   SORGHR, SORMHR, STREVC
89*     ..
90*     .. Intrinsic Functions ..
91      INTRINSIC          REAL
92*     ..
93*     .. Scalars in Common ..
94      LOGICAL            LERR, OK
95      CHARACTER*32       SRNAMT
96      INTEGER            INFOT, NOUT
97*     ..
98*     .. Common blocks ..
99      COMMON             / INFOC / INFOT, NOUT, OK, LERR
100      COMMON             / SRNAMC / SRNAMT
101*     ..
102*     .. Executable Statements ..
103*
104      NOUT = NUNIT
105      WRITE( NOUT, FMT = * )
106      C2 = PATH( 2: 3 )
107*
108*     Set the variables to innocuous values.
109*
110      DO 20 J = 1, NMAX
111         DO 10 I = 1, NMAX
112            A( I, J ) = 1. / REAL( I+J )
113   10    CONTINUE
114         WI( J ) = REAL( J )
115         SEL( J ) = .TRUE.
116   20 CONTINUE
117      OK = .TRUE.
118      NT = 0
119*
120*     Test error exits of the nonsymmetric eigenvalue routines.
121*
122      IF( LSAMEN( 2, C2, 'HS' ) ) THEN
123*
124*        SGEBAL
125*
126         SRNAMT = 'SGEBAL'
127         INFOT = 1
128         CALL SGEBAL( '/', 0, A, 1, ILO, IHI, S, INFO )
129         CALL CHKXER( 'SGEBAL', INFOT, NOUT, LERR, OK )
130         INFOT = 2
131         CALL SGEBAL( 'N', -1, A, 1, ILO, IHI, S, INFO )
132         CALL CHKXER( 'SGEBAL', INFOT, NOUT, LERR, OK )
133         INFOT = 4
134         CALL SGEBAL( 'N', 2, A, 1, ILO, IHI, S, INFO )
135         CALL CHKXER( 'SGEBAL', INFOT, NOUT, LERR, OK )
136         NT = NT + 3
137*
138*        SGEBAK
139*
140         SRNAMT = 'SGEBAK'
141         INFOT = 1
142         CALL SGEBAK( '/', 'R', 0, 1, 0, S, 0, A, 1, INFO )
143         CALL CHKXER( 'SGEBAK', INFOT, NOUT, LERR, OK )
144         INFOT = 2
145         CALL SGEBAK( 'N', '/', 0, 1, 0, S, 0, A, 1, INFO )
146         CALL CHKXER( 'SGEBAK', INFOT, NOUT, LERR, OK )
147         INFOT = 3
148         CALL SGEBAK( 'N', 'R', -1, 1, 0, S, 0, A, 1, INFO )
149         CALL CHKXER( 'SGEBAK', INFOT, NOUT, LERR, OK )
150         INFOT = 4
151         CALL SGEBAK( 'N', 'R', 0, 0, 0, S, 0, A, 1, INFO )
152         CALL CHKXER( 'SGEBAK', INFOT, NOUT, LERR, OK )
153         INFOT = 4
154         CALL SGEBAK( 'N', 'R', 0, 2, 0, S, 0, A, 1, INFO )
155         CALL CHKXER( 'SGEBAK', INFOT, NOUT, LERR, OK )
156         INFOT = 5
157         CALL SGEBAK( 'N', 'R', 2, 2, 1, S, 0, A, 2, INFO )
158         CALL CHKXER( 'SGEBAK', INFOT, NOUT, LERR, OK )
159         INFOT = 5
160         CALL SGEBAK( 'N', 'R', 0, 1, 1, S, 0, A, 1, INFO )
161         CALL CHKXER( 'SGEBAK', INFOT, NOUT, LERR, OK )
162         INFOT = 7
163         CALL SGEBAK( 'N', 'R', 0, 1, 0, S, -1, A, 1, INFO )
164         CALL CHKXER( 'SGEBAK', INFOT, NOUT, LERR, OK )
165         INFOT = 9
166         CALL SGEBAK( 'N', 'R', 2, 1, 2, S, 0, A, 1, INFO )
167         CALL CHKXER( 'SGEBAK', INFOT, NOUT, LERR, OK )
168         NT = NT + 9
169*
170*        SGEHRD
171*
172         SRNAMT = 'SGEHRD'
173         INFOT = 1
174         CALL SGEHRD( -1, 1, 1, A, 1, TAU, W, 1, INFO )
175         CALL CHKXER( 'SGEHRD', INFOT, NOUT, LERR, OK )
176         INFOT = 2
177         CALL SGEHRD( 0, 0, 0, A, 1, TAU, W, 1, INFO )
178         CALL CHKXER( 'SGEHRD', INFOT, NOUT, LERR, OK )
179         INFOT = 2
180         CALL SGEHRD( 0, 2, 0, A, 1, TAU, W, 1, INFO )
181         CALL CHKXER( 'SGEHRD', INFOT, NOUT, LERR, OK )
182         INFOT = 3
183         CALL SGEHRD( 1, 1, 0, A, 1, TAU, W, 1, INFO )
184         CALL CHKXER( 'SGEHRD', INFOT, NOUT, LERR, OK )
185         INFOT = 3
186         CALL SGEHRD( 0, 1, 1, A, 1, TAU, W, 1, INFO )
187         CALL CHKXER( 'SGEHRD', INFOT, NOUT, LERR, OK )
188         INFOT = 5
189         CALL SGEHRD( 2, 1, 1, A, 1, TAU, W, 2, INFO )
190         CALL CHKXER( 'SGEHRD', INFOT, NOUT, LERR, OK )
191         INFOT = 8
192         CALL SGEHRD( 2, 1, 2, A, 2, TAU, W, 1, INFO )
193         CALL CHKXER( 'SGEHRD', INFOT, NOUT, LERR, OK )
194         NT = NT + 7
195*
196*        SORGHR
197*
198         SRNAMT = 'SORGHR'
199         INFOT = 1
200         CALL SORGHR( -1, 1, 1, A, 1, TAU, W, 1, INFO )
201         CALL CHKXER( 'SORGHR', INFOT, NOUT, LERR, OK )
202         INFOT = 2
203         CALL SORGHR( 0, 0, 0, A, 1, TAU, W, 1, INFO )
204         CALL CHKXER( 'SORGHR', INFOT, NOUT, LERR, OK )
205         INFOT = 2
206         CALL SORGHR( 0, 2, 0, A, 1, TAU, W, 1, INFO )
207         CALL CHKXER( 'SORGHR', INFOT, NOUT, LERR, OK )
208         INFOT = 3
209         CALL SORGHR( 1, 1, 0, A, 1, TAU, W, 1, INFO )
210         CALL CHKXER( 'SORGHR', INFOT, NOUT, LERR, OK )
211         INFOT = 3
212         CALL SORGHR( 0, 1, 1, A, 1, TAU, W, 1, INFO )
213         CALL CHKXER( 'SORGHR', INFOT, NOUT, LERR, OK )
214         INFOT = 5
215         CALL SORGHR( 2, 1, 1, A, 1, TAU, W, 1, INFO )
216         CALL CHKXER( 'SORGHR', INFOT, NOUT, LERR, OK )
217         INFOT = 8
218         CALL SORGHR( 3, 1, 3, A, 3, TAU, W, 1, INFO )
219         CALL CHKXER( 'SORGHR', INFOT, NOUT, LERR, OK )
220         NT = NT + 7
221*
222*        SORMHR
223*
224         SRNAMT = 'SORMHR'
225         INFOT = 1
226         CALL SORMHR( '/', 'N', 0, 0, 1, 0, A, 1, TAU, C, 1, W, 1,
227     $                INFO )
228         CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
229         INFOT = 2
230         CALL SORMHR( 'L', '/', 0, 0, 1, 0, A, 1, TAU, C, 1, W, 1,
231     $                INFO )
232         CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
233         INFOT = 3
234         CALL SORMHR( 'L', 'N', -1, 0, 1, 0, A, 1, TAU, C, 1, W, 1,
235     $                INFO )
236         CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
237         INFOT = 4
238         CALL SORMHR( 'L', 'N', 0, -1, 1, 0, A, 1, TAU, C, 1, W, 1,
239     $                INFO )
240         CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
241         INFOT = 5
242         CALL SORMHR( 'L', 'N', 0, 0, 0, 0, A, 1, TAU, C, 1, W, 1,
243     $                INFO )
244         CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
245         INFOT = 5
246         CALL SORMHR( 'L', 'N', 0, 0, 2, 0, A, 1, TAU, C, 1, W, 1,
247     $                INFO )
248         CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
249         INFOT = 5
250         CALL SORMHR( 'L', 'N', 1, 2, 2, 1, A, 1, TAU, C, 1, W, 2,
251     $                INFO )
252         CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
253         INFOT = 5
254         CALL SORMHR( 'R', 'N', 2, 1, 2, 1, A, 1, TAU, C, 2, W, 2,
255     $                INFO )
256         CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
257         INFOT = 6
258         CALL SORMHR( 'L', 'N', 1, 1, 1, 0, A, 1, TAU, C, 1, W, 1,
259     $                INFO )
260         CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
261         INFOT = 6
262         CALL SORMHR( 'L', 'N', 0, 1, 1, 1, A, 1, TAU, C, 1, W, 1,
263     $                INFO )
264         CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
265         INFOT = 6
266         CALL SORMHR( 'R', 'N', 1, 0, 1, 1, A, 1, TAU, C, 1, W, 1,
267     $                INFO )
268         CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
269         INFOT = 8
270         CALL SORMHR( 'L', 'N', 2, 1, 1, 1, A, 1, TAU, C, 2, W, 1,
271     $                INFO )
272         CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
273         INFOT = 8
274         CALL SORMHR( 'R', 'N', 1, 2, 1, 1, A, 1, TAU, C, 1, W, 1,
275     $                INFO )
276         CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
277         INFOT = 11
278         CALL SORMHR( 'L', 'N', 2, 1, 1, 1, A, 2, TAU, C, 1, W, 1,
279     $                INFO )
280         CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
281         INFOT = 13
282         CALL SORMHR( 'L', 'N', 1, 2, 1, 1, A, 1, TAU, C, 1, W, 1,
283     $                INFO )
284         CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
285         INFOT = 13
286         CALL SORMHR( 'R', 'N', 2, 1, 1, 1, A, 1, TAU, C, 2, W, 1,
287     $                INFO )
288         CALL CHKXER( 'SORMHR', INFOT, NOUT, LERR, OK )
289         NT = NT + 16
290*
291*        SHSEQR
292*
293         SRNAMT = 'SHSEQR'
294         INFOT = 1
295         CALL SHSEQR( '/', 'N', 0, 1, 0, A, 1, WR, WI, C, 1, W, 1,
296     $                INFO )
297         CALL CHKXER( 'SHSEQR', INFOT, NOUT, LERR, OK )
298         INFOT = 2
299         CALL SHSEQR( 'E', '/', 0, 1, 0, A, 1, WR, WI, C, 1, W, 1,
300     $                INFO )
301         CALL CHKXER( 'SHSEQR', INFOT, NOUT, LERR, OK )
302         INFOT = 3
303         CALL SHSEQR( 'E', 'N', -1, 1, 0, A, 1, WR, WI, C, 1, W, 1,
304     $                INFO )
305         CALL CHKXER( 'SHSEQR', INFOT, NOUT, LERR, OK )
306         INFOT = 4
307         CALL SHSEQR( 'E', 'N', 0, 0, 0, A, 1, WR, WI, C, 1, W, 1,
308     $                INFO )
309         CALL CHKXER( 'SHSEQR', INFOT, NOUT, LERR, OK )
310         INFOT = 4
311         CALL SHSEQR( 'E', 'N', 0, 2, 0, A, 1, WR, WI, C, 1, W, 1,
312     $                INFO )
313         CALL CHKXER( 'SHSEQR', INFOT, NOUT, LERR, OK )
314         INFOT = 5
315         CALL SHSEQR( 'E', 'N', 1, 1, 0, A, 1, WR, WI, C, 1, W, 1,
316     $                INFO )
317         CALL CHKXER( 'SHSEQR', INFOT, NOUT, LERR, OK )
318         INFOT = 5
319         CALL SHSEQR( 'E', 'N', 1, 1, 2, A, 1, WR, WI, C, 1, W, 1,
320     $                INFO )
321         CALL CHKXER( 'SHSEQR', INFOT, NOUT, LERR, OK )
322         INFOT = 7
323         CALL SHSEQR( 'E', 'N', 2, 1, 2, A, 1, WR, WI, C, 2, W, 1,
324     $                INFO )
325         CALL CHKXER( 'SHSEQR', INFOT, NOUT, LERR, OK )
326         INFOT = 11
327         CALL SHSEQR( 'E', 'V', 2, 1, 2, A, 2, WR, WI, C, 1, W, 1,
328     $                INFO )
329         CALL CHKXER( 'SHSEQR', INFOT, NOUT, LERR, OK )
330         NT = NT + 9
331*
332*        SHSEIN
333*
334         SRNAMT = 'SHSEIN'
335         INFOT = 1
336         CALL SHSEIN( '/', 'N', 'N', SEL, 0, A, 1, WR, WI, VL, 1, VR, 1,
337     $                0, M, W, IFAILL, IFAILR, INFO )
338         CALL CHKXER( 'SHSEIN', INFOT, NOUT, LERR, OK )
339         INFOT = 2
340         CALL SHSEIN( 'R', '/', 'N', SEL, 0, A, 1, WR, WI, VL, 1, VR, 1,
341     $                0, M, W, IFAILL, IFAILR, INFO )
342         CALL CHKXER( 'SHSEIN', INFOT, NOUT, LERR, OK )
343         INFOT = 3
344         CALL SHSEIN( 'R', 'N', '/', SEL, 0, A, 1, WR, WI, VL, 1, VR, 1,
345     $                0, M, W, IFAILL, IFAILR, INFO )
346         CALL CHKXER( 'SHSEIN', INFOT, NOUT, LERR, OK )
347         INFOT = 5
348         CALL SHSEIN( 'R', 'N', 'N', SEL, -1, A, 1, WR, WI, VL, 1, VR,
349     $                1, 0, M, W, IFAILL, IFAILR, INFO )
350         CALL CHKXER( 'SHSEIN', INFOT, NOUT, LERR, OK )
351         INFOT = 7
352         CALL SHSEIN( 'R', 'N', 'N', SEL, 2, A, 1, WR, WI, VL, 1, VR, 2,
353     $                4, M, W, IFAILL, IFAILR, INFO )
354         CALL CHKXER( 'SHSEIN', INFOT, NOUT, LERR, OK )
355         INFOT = 11
356         CALL SHSEIN( 'L', 'N', 'N', SEL, 2, A, 2, WR, WI, VL, 1, VR, 1,
357     $                4, M, W, IFAILL, IFAILR, INFO )
358         CALL CHKXER( 'SHSEIN', INFOT, NOUT, LERR, OK )
359         INFOT = 13
360         CALL SHSEIN( 'R', 'N', 'N', SEL, 2, A, 2, WR, WI, VL, 1, VR, 1,
361     $                4, M, W, IFAILL, IFAILR, INFO )
362         CALL CHKXER( 'SHSEIN', INFOT, NOUT, LERR, OK )
363         INFOT = 14
364         CALL SHSEIN( 'R', 'N', 'N', SEL, 2, A, 2, WR, WI, VL, 1, VR, 2,
365     $                1, M, W, IFAILL, IFAILR, INFO )
366         CALL CHKXER( 'SHSEIN', INFOT, NOUT, LERR, OK )
367         NT = NT + 8
368*
369*        STREVC
370*
371         SRNAMT = 'STREVC'
372         INFOT = 1
373         CALL STREVC( '/', 'A', SEL, 0, A, 1, VL, 1, VR, 1, 0, M, W,
374     $                INFO )
375         CALL CHKXER( 'STREVC', INFOT, NOUT, LERR, OK )
376         INFOT = 2
377         CALL STREVC( 'L', '/', SEL, 0, A, 1, VL, 1, VR, 1, 0, M, W,
378     $                INFO )
379         CALL CHKXER( 'STREVC', INFOT, NOUT, LERR, OK )
380         INFOT = 4
381         CALL STREVC( 'L', 'A', SEL, -1, A, 1, VL, 1, VR, 1, 0, M, W,
382     $                INFO )
383         CALL CHKXER( 'STREVC', INFOT, NOUT, LERR, OK )
384         INFOT = 6
385         CALL STREVC( 'L', 'A', SEL, 2, A, 1, VL, 2, VR, 1, 4, M, W,
386     $                INFO )
387         CALL CHKXER( 'STREVC', INFOT, NOUT, LERR, OK )
388         INFOT = 8
389         CALL STREVC( 'L', 'A', SEL, 2, A, 2, VL, 1, VR, 1, 4, M, W,
390     $                INFO )
391         CALL CHKXER( 'STREVC', INFOT, NOUT, LERR, OK )
392         INFOT = 10
393         CALL STREVC( 'R', 'A', SEL, 2, A, 2, VL, 1, VR, 1, 4, M, W,
394     $                INFO )
395         CALL CHKXER( 'STREVC', INFOT, NOUT, LERR, OK )
396         INFOT = 11
397         CALL STREVC( 'L', 'A', SEL, 2, A, 2, VL, 2, VR, 1, 1, M, W,
398     $                INFO )
399         CALL CHKXER( 'STREVC', INFOT, NOUT, LERR, OK )
400         NT = NT + 7
401      END IF
402*
403*     Print a summary line.
404*
405      IF( OK ) THEN
406         WRITE( NOUT, FMT = 9999 )PATH, NT
407      ELSE
408         WRITE( NOUT, FMT = 9998 )PATH
409      END IF
410*
411 9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits',
412     $        ' (', I3, ' tests done)' )
413 9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ',
414     $      'exits ***' )
415*
416      RETURN
417*
418*     End of SERRHS
419*
420      END
421