LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
schkec.f
Go to the documentation of this file.
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,
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
subroutine sget40(RMAX, LMAX, NINFO, KNT, NIN)
SGET40
Definition: sget40.f:83
subroutine sget36(RMAX, LMAX, NINFO, KNT, NIN)
SGET36
Definition: sget36.f:88
subroutine sget38(RMAX, LMAX, NINFO, KNT, NIN)
SGET38
Definition: sget38.f:91
subroutine sget33(RMAX, LMAX, NINFO, KNT)
SGET33
Definition: sget33.f:76
subroutine sget31(RMAX, LMAX, NINFO, KNT)
SGET31
Definition: sget31.f:91
subroutine serrec(PATH, NUNIT)
SERREC
Definition: serrec.f:56
subroutine schkec(THRESH, TSTERR, NIN, NOUT)
SCHKEC
Definition: schkec.f:76
subroutine sget34(RMAX, LMAX, NINFO, KNT)
SGET34
Definition: sget34.f:82
subroutine sget37(RMAX, LMAX, NINFO, KNT, NIN)
SGET37
Definition: sget37.f:90
subroutine sget35(RMAX, LMAX, NINFO, KNT)
SGET35
Definition: sget35.f:78
subroutine sget39(RMAX, LMAX, NINFO, KNT)
SGET39
Definition: sget39.f:103
subroutine sget32(RMAX, LMAX, NINFO, KNT)
SGET32
Definition: sget32.f:82