LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
cchkec.f
Go to the documentation of this file.
1*> \brief \b CCHKEC
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 CCHKEC( 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*> CCHKEC tests eigen- condition estimation routines
26*> CTRSYL, CTRSYL3, CTREXC, CTRSNA, CTRSEN
27*>
28*> In all cases, the routine runs through a fixed set of numerical
29*> examples, subjects them to various tests, and compares the test
30*> results to a threshold THRESH. In addition, CTRSNA and CTRSEN are
31*> tested by reading in precomputed examples from a file (on input unit
32*> NIN). Output is written to output unit NOUT.
33*> \endverbatim
34*
35* Arguments:
36* ==========
37*
38*> \param[in] THRESH
39*> \verbatim
40*> THRESH is REAL
41*> Threshold for residual tests. A computed test ratio passes
42*> the threshold if it is less than THRESH.
43*> \endverbatim
44*>
45*> \param[in] TSTERR
46*> \verbatim
47*> TSTERR is LOGICAL
48*> Flag that indicates whether error exits are to be tested.
49*> \endverbatim
50*>
51*> \param[in] NIN
52*> \verbatim
53*> NIN is INTEGER
54*> The logical unit number for input.
55*> \endverbatim
56*>
57*> \param[in] NOUT
58*> \verbatim
59*> NOUT is INTEGER
60*> The logical unit number for output.
61*> \endverbatim
62*
63* Authors:
64* ========
65*
66*> \author Univ. of Tennessee
67*> \author Univ. of California Berkeley
68*> \author Univ. of Colorado Denver
69*> \author NAG Ltd.
70*
71*> \ingroup complex_eig
72*
73* =====================================================================
74 SUBROUTINE cchkec( THRESH, TSTERR, NIN, NOUT )
75*
76* -- LAPACK test routine --
77* -- LAPACK is a software package provided by Univ. of Tennessee, --
78* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
79*
80* .. Scalar Arguments ..
81 LOGICAL TSTERR
82 INTEGER NIN, NOUT
83 REAL THRESH
84* ..
85*
86* =====================================================================
87*
88* .. Local Scalars ..
89 LOGICAL OK
90 CHARACTER*3 PATH
91 INTEGER KTREXC, KTRSEN, KTRSNA, KTRSYL, KTRSYL3,
92 $ LTREXC, LTRSYL, NTESTS, NTREXC, NTRSYL
93 REAL EPS, RTREXC, SFMIN
94* ..
95* .. Local Arrays ..
96 INTEGER FTRSYL( 3 ), ITRSYL( 2 ), LTRSEN( 3 ),
97 $ LTRSNA( 3 ), NTRSEN( 3 ), NTRSNA( 3 )
98 REAL RTRSEN( 3 ), RTRSNA( 3 ), RTRSYL( 2 )
99* ..
100* .. External Subroutines ..
101 EXTERNAL cerrec, cget35, cget36, cget37, cget38, csyl01
102* ..
103* .. External Functions ..
104 REAL SLAMCH
105 EXTERNAL slamch
106* ..
107* .. Executable Statements ..
108*
109 path( 1: 1 ) = 'Complex precision'
110 path( 2: 3 ) = 'EC'
111 eps = slamch( 'P' )
112 sfmin = slamch( 'S' )
113 WRITE( nout, fmt = 9994 )
114 WRITE( nout, fmt = 9993 )eps, sfmin
115 WRITE( nout, fmt = 9992 )thresh
116*
117* Test error exits if TSTERR is .TRUE.
118*
119 IF( tsterr )
120 $ CALL cerrec( path, nout )
121*
122 ok = .true.
123 CALL cget35( rtrsyl( 1 ), ltrsyl, ntrsyl, ktrsyl, nin )
124 IF( rtrsyl( 1 ).GT.thresh ) THEN
125 ok = .false.
126 WRITE( nout, fmt = 9999 )rtrsyl( 1 ), ltrsyl, ntrsyl, ktrsyl
127 END IF
128*
129 CALL csyl01( thresh, ftrsyl, rtrsyl, itrsyl, ktrsyl3 )
130 IF( ftrsyl( 1 ).GT.0 ) THEN
131 ok = .false.
132 WRITE( nout, fmt = 9970 )ftrsyl( 1 ), rtrsyl( 1 ), thresh
133 END IF
134 IF( ftrsyl( 2 ).GT.0 ) THEN
135 ok = .false.
136 WRITE( nout, fmt = 9971 )ftrsyl( 2 ), rtrsyl( 2 ), thresh
137 END IF
138 IF( ftrsyl( 3 ).GT.0 ) THEN
139 ok = .false.
140 WRITE( nout, fmt = 9972 )ftrsyl( 3 )
141 END IF
142*
143 CALL cget36( rtrexc, ltrexc, ntrexc, ktrexc, nin )
144 IF( rtrexc.GT.thresh .OR. ntrexc.GT.0 ) THEN
145 ok = .false.
146 WRITE( nout, fmt = 9998 )rtrexc, ltrexc, ntrexc, ktrexc
147 END IF
148*
149 CALL cget37( rtrsna, ltrsna, ntrsna, ktrsna, nin )
150 IF( rtrsna( 1 ).GT.thresh .OR. rtrsna( 2 ).GT.thresh .OR.
151 $ ntrsna( 1 ).NE.0 .OR. ntrsna( 2 ).NE.0 .OR. ntrsna( 3 ).NE.0 )
152 $ THEN
153 ok = .false.
154 WRITE( nout, fmt = 9997 )rtrsna, ltrsna, ntrsna, ktrsna
155 END IF
156*
157 CALL cget38( rtrsen, ltrsen, ntrsen, ktrsen, nin )
158 IF( rtrsen( 1 ).GT.thresh .OR. rtrsen( 2 ).GT.thresh .OR.
159 $ ntrsen( 1 ).NE.0 .OR. ntrsen( 2 ).NE.0 .OR. ntrsen( 3 ).NE.0 )
160 $ THEN
161 ok = .false.
162 WRITE( nout, fmt = 9996 )rtrsen, ltrsen, ntrsen, ktrsen
163 END IF
164*
165 ntests = ktrsyl + ktrexc + ktrsna + ktrsen
166 IF( ok )
167 $ WRITE( nout, fmt = 9995 )path, ntests
168*
169 9999 FORMAT( ' Error in CTRSYL: RMAX =', e12.3, / ' LMAX = ', i8,
170 $ ' NINFO=', i8, ' KNT=', i8 )
171 9998 FORMAT( ' Error in CTREXC: RMAX =', e12.3, / ' LMAX = ', i8,
172 $ ' NINFO=', i8, ' KNT=', i8 )
173 9997 FORMAT( ' Error in CTRSNA: RMAX =', 3e12.3, / ' LMAX = ',
174 $ 3i8, ' NINFO=', 3i8, ' KNT=', i8 )
175 9996 FORMAT( ' Error in CTRSEN: RMAX =', 3e12.3, / ' LMAX = ',
176 $ 3i8, ' NINFO=', 3i8, ' KNT=', i8 )
177 9995 FORMAT( / 1x, 'All tests for ', a3,
178 $ ' routines passed the threshold ( ', i6, ' tests run)' )
179 9994 FORMAT( ' Tests of the Nonsymmetric eigenproblem condition',
180 $ ' estimation routines', / ' CTRSYL, CTREXC, CTRSNA, CTRSEN',
181 $ / )
182 9993 FORMAT( ' Relative machine precision (EPS) = ', e16.6,
183 $ / ' Safe minimum (SFMIN) = ', e16.6, / )
184 9992 FORMAT( ' Routines pass computational tests if test ratio is ',
185 $ 'less than', f8.2, / / )
186 9972 FORMAT( 'CTRSYL and CTRSYL3 compute an inconsistent scale ',
187 $ 'factor in ', i8, ' tests.')
188 9971 FORMAT( 'Error in CTRSYL3: ', i8, ' tests fail the threshold.', /
189 $ 'Maximum test ratio =', d12.3, ' threshold =', d12.3 )
190 9970 FORMAT( 'Error in CTRSYL: ', i8, ' tests fail the threshold.', /
191 $ 'Maximum test ratio =', d12.3, ' threshold =', d12.3 )
192 RETURN
193*
194* End of CCHKEC
195*
196 END
subroutine csyl01(THRESH, NFAIL, RMAX, NINFO, KNT)
CSYL01
Definition: csyl01.f:89
subroutine cget38(RMAX, LMAX, NINFO, KNT, NIN)
CGET38
Definition: cget38.f:91
subroutine cchkec(THRESH, TSTERR, NIN, NOUT)
CCHKEC
Definition: cchkec.f:75
subroutine cerrec(PATH, NUNIT)
CERREC
Definition: cerrec.f:56
subroutine cget37(RMAX, LMAX, NINFO, KNT, NIN)
CGET37
Definition: cget37.f:90
subroutine cget35(RMAX, LMAX, NINFO, KNT, NIN)
CGET35
Definition: cget35.f:84
subroutine cget36(RMAX, LMAX, NINFO, KNT, NIN)
CGET36
Definition: cget36.f:85