1*> \brief \b SCHKEC
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 SCHKEC( THRESH, TSTERR, NIN, NOUT )
12*
13*       .. Scalar Arguments ..
14*       LOGICAL            TSTERR
15*       INTEGER            NIN, NOUT
16*       REAL               THRESH
17*       ..
18*
19*
20*> \par Purpose:
21*  =============
22*>
23*> \verbatim
24*>
25*> SCHKEC tests eigen- condition estimation routines
26*>        SLALN2, SLASY2, SLANV2, SLAQTR, SLAEXC,
27*>        STRSYL, STREXC, STRSNA, STRSEN, STGEXC
28*>
29*> In all cases, the routine runs through a fixed set of numerical
30*> examples, subjects them to various tests, and compares the test
31*> results to a threshold THRESH. In addition, STREXC, STRSNA and STRSEN
32*> are tested by reading in precomputed examples from a file (on input
33*> unit NIN).  Output is written to output unit NOUT.
34*> \endverbatim
35*
36*  Arguments:
37*  ==========
38*
39*> \param[in] THRESH
40*> \verbatim
41*>          THRESH is REAL
42*>          Threshold for residual tests.  A computed test ratio passes
43*>          the threshold if it is less than THRESH.
44*> \endverbatim
45*>
46*> \param[in] TSTERR
47*> \verbatim
48*>          TSTERR is LOGICAL
49*>          Flag that indicates whether error exits are to be tested.
50*> \endverbatim
51*>
52*> \param[in] NIN
53*> \verbatim
54*>          NIN is INTEGER
55*>          The logical unit number for input.
56*> \endverbatim
57*>
58*> \param[in] NOUT
59*> \verbatim
60*>          NOUT is INTEGER
61*>          The logical unit number for output.
62*> \endverbatim
63*
64*  Authors:
65*  ========
66*
67*> \author Univ. of Tennessee
68*> \author Univ. of California Berkeley
69*> \author Univ. of Colorado Denver
70*> \author NAG Ltd.
71*
72*> \ingroup single_eig
73*
74*  =====================================================================
75      SUBROUTINE SCHKEC( THRESH, TSTERR, NIN, NOUT )
76*
77*  -- LAPACK test routine --
78*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
79*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
80*
81*     .. Scalar Arguments ..
82      LOGICAL            TSTERR
83      INTEGER            NIN, NOUT
84      REAL               THRESH
85*     ..
86*
87*  =====================================================================
88*
89*     .. Local Scalars ..
90      LOGICAL            OK
91      CHARACTER*3        PATH
92      INTEGER            KLAEXC, KLALN2, KLANV2, KLAQTR, KLASY2, KTREXC,
93     $                   KTRSEN, KTRSNA, KTRSYL, LLAEXC, LLALN2, LLANV2,
94     $                   LLAQTR, LLASY2, LTREXC, LTRSYL, NLANV2, NLAQTR,
95     $                   NLASY2, NTESTS, NTRSYL, KTGEXC, NTGEXC, LTGEXC
96      REAL               EPS, RLAEXC, RLALN2, RLANV2, RLAQTR, RLASY2,
97     $                   RTREXC, RTRSYL, SFMIN, RTGEXC
98*     ..
99*     .. Local Arrays ..
100      INTEGER            LTRSEN( 3 ), LTRSNA( 3 ), NLAEXC( 2 ),
101     $                   NLALN2( 2 ), NTREXC( 3 ), NTRSEN( 3 ),
102     $                   NTRSNA( 3 )
103      REAL               RTRSEN( 3 ), RTRSNA( 3 )
104*     ..
105*     .. External Subroutines ..
106      EXTERNAL           SERREC, SGET31, SGET32, SGET33, SGET34, SGET35,
107     $                   SGET36, SGET37, SGET38, SGET39, SGET40
108*     ..
109*     .. External Functions ..
110      REAL               SLAMCH
111      EXTERNAL           SLAMCH
112*     ..
113*     .. Executable Statements ..
114*
115      PATH( 1: 1 ) = 'Single precision'
116      PATH( 2: 3 ) = 'EC'
117      EPS = SLAMCH( 'P' )
118      SFMIN = SLAMCH( 'S' )
119*
120*     Print header information
121*
122      WRITE( NOUT, FMT = 9989 )
123      WRITE( NOUT, FMT = 9988 )EPS, SFMIN
124      WRITE( NOUT, FMT = 9987 )THRESH
125*
126*     Test error exits if TSTERR is .TRUE.
127*
128      IF( TSTERR )
129     $   CALL SERREC( PATH, NOUT )
130*
131      OK = .TRUE.
132      CALL SGET31( RLALN2, LLALN2, NLALN2, KLALN2 )
133      IF( RLALN2.GT.THRESH .OR. NLALN2( 1 ).NE.0 ) THEN
134         OK = .FALSE.
135         WRITE( NOUT, FMT = 9999 )RLALN2, LLALN2, NLALN2, KLALN2
136      END IF
137*
138      CALL SGET32( RLASY2, LLASY2, NLASY2, KLASY2 )
139      IF( RLASY2.GT.THRESH ) THEN
140         OK = .FALSE.
141         WRITE( NOUT, FMT = 9998 )RLASY2, LLASY2, NLASY2, KLASY2
142      END IF
143*
144      CALL SGET33( RLANV2, LLANV2, NLANV2, KLANV2 )
145      IF( RLANV2.GT.THRESH .OR. NLANV2.NE.0 ) THEN
146         OK = .FALSE.
147         WRITE( NOUT, FMT = 9997 )RLANV2, LLANV2, NLANV2, KLANV2
148      END IF
149*
150      CALL SGET34( RLAEXC, LLAEXC, NLAEXC, KLAEXC )
151      IF( RLAEXC.GT.THRESH .OR. NLAEXC( 2 ).NE.0 ) THEN
152         OK = .FALSE.
153         WRITE( NOUT, FMT = 9996 )RLAEXC, LLAEXC, NLAEXC, KLAEXC
154      END IF
155*
156      CALL SGET35( RTRSYL, LTRSYL, NTRSYL, KTRSYL )
157      IF( RTRSYL.GT.THRESH ) THEN
158         OK = .FALSE.
159         WRITE( NOUT, FMT = 9995 )RTRSYL, LTRSYL, NTRSYL, KTRSYL
160      END IF
161*
162      CALL SGET36( RTREXC, LTREXC, NTREXC, KTREXC, NIN )
163      IF( RTREXC.GT.THRESH .OR. NTREXC( 3 ).GT.0 ) THEN
164         OK = .FALSE.
165         WRITE( NOUT, FMT = 9994 )RTREXC, LTREXC, NTREXC, KTREXC
166      END IF
167*
168      CALL SGET37( RTRSNA, LTRSNA, NTRSNA, KTRSNA, NIN )
169      IF( RTRSNA( 1 ).GT.THRESH .OR. RTRSNA( 2 ).GT.THRESH .OR.
170     $    NTRSNA( 1 ).NE.0 .OR. NTRSNA( 2 ).NE.0 .OR. NTRSNA( 3 ).NE.0 )
171     $     THEN
172         OK = .FALSE.
173         WRITE( NOUT, FMT = 9993 )RTRSNA, LTRSNA, NTRSNA, KTRSNA
174      END IF
175*
176      CALL SGET38( RTRSEN, LTRSEN, NTRSEN, KTRSEN, NIN )
177      IF( RTRSEN( 1 ).GT.THRESH .OR. RTRSEN( 2 ).GT.THRESH .OR.
178     $    NTRSEN( 1 ).NE.0 .OR. NTRSEN( 2 ).NE.0 .OR. NTRSEN( 3 ).NE.0 )
179     $     THEN
180         OK = .FALSE.
181         WRITE( NOUT, FMT = 9992 )RTRSEN, LTRSEN, NTRSEN, KTRSEN
182      END IF
183*
184      CALL SGET39( RLAQTR, LLAQTR, NLAQTR, KLAQTR )
185      IF( RLAQTR.GT.THRESH ) THEN
186         OK = .FALSE.
187         WRITE( NOUT, FMT = 9991 )RLAQTR, LLAQTR, NLAQTR, KLAQTR
188      END IF
189*
190      CALL SGET40( RTGEXC, LTGEXC, NTGEXC, KTGEXC, NIN )
191      IF( RTGEXC.GT.THRESH ) THEN
192         OK = .FALSE.
193         WRITE( NOUT, FMT = 9986 )RTGEXC, LTGEXC, NTGEXC, KTGEXC
194      END IF
195*
196      NTESTS = KLALN2 + KLASY2 + KLANV2 + KLAEXC + KTRSYL + KTREXC +
197     $         KTRSNA + KTRSEN + KLAQTR
198      IF( OK )
199     $   WRITE( NOUT, FMT = 9990 )PATH, NTESTS
200*
201      RETURN
202 9999 FORMAT( ' Error in SLALN2: RMAX =', E12.3, / ' LMAX = ', I8, ' N',
203     $      'INFO=', 2I8, ' KNT=', I8 )
204 9998 FORMAT( ' Error in SLASY2: RMAX =', E12.3, / ' LMAX = ', I8, ' N',
205     $      'INFO=', I8, ' KNT=', I8 )
206 9997 FORMAT( ' Error in SLANV2: RMAX =', E12.3, / ' LMAX = ', I8, ' N',
207     $      'INFO=', I8, ' KNT=', I8 )
208 9996 FORMAT( ' Error in SLAEXC: RMAX =', E12.3, / ' LMAX = ', I8, ' N',
209     $      'INFO=', 2I8, ' KNT=', I8 )
210 9995 FORMAT( ' Error in STRSYL: RMAX =', E12.3, / ' LMAX = ', I8, ' N',
211     $      'INFO=', I8, ' KNT=', I8 )
212 9994 FORMAT( ' Error in STREXC: RMAX =', E12.3, / ' LMAX = ', I8, ' N',
213     $      'INFO=', 3I8, ' KNT=', I8 )
214 9993 FORMAT( ' Error in STRSNA: RMAX =', 3E12.3, / ' LMAX = ', 3I8,
215     $      ' NINFO=', 3I8, ' KNT=', I8 )
216 9992 FORMAT( ' Error in STRSEN: RMAX =', 3E12.3, / ' LMAX = ', 3I8,
217     $      ' NINFO=', 3I8, ' KNT=', I8 )
218 9991 FORMAT( ' Error in SLAQTR: RMAX =', E12.3, / ' LMAX = ', I8, ' N',
219     $      'INFO=', I8, ' KNT=', I8 )
220 9990 FORMAT( / 1X, 'All tests for ', A3, ' routines passed the thresh',
221     $      'old ( ', I6, ' tests run)' )
222 9989 FORMAT( ' Tests of the Nonsymmetric eigenproblem condition estim',
223     $      'ation routines', / ' SLALN2, SLASY2, SLANV2, SLAEXC, STRS',
224     $      'YL, STREXC, STRSNA, STRSEN, SLAQTR', / )
225 9988 FORMAT( ' Relative machine precision (EPS) = ', E16.6, / ' Safe ',
226     $      'minimum (SFMIN)             = ', E16.6, / )
227 9987 FORMAT( ' Routines pass computational tests if test ratio is les',
228     $      's than', F8.2, / / )
229 9986 FORMAT( ' Error in STGEXC: RMAX =', E12.3, / ' LMAX = ', I8, ' N',
230     $      'INFO=', I8, ' KNT=', I8 )
231*
232*     End of SCHKEC
233*
234      END
235