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