1*> \brief \b DCHKEC 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 DCHKEC( THRESH, TSTERR, NIN, NOUT ) 12* 13* .. Scalar Arguments .. 14* LOGICAL TSTERR 15* INTEGER NIN, NOUT 16* DOUBLE PRECISION THRESH 17* .. 18* 19* 20*> \par Purpose: 21* ============= 22*> 23*> \verbatim 24*> 25*> DCHKEC tests eigen- condition estimation routines 26*> DLALN2, DLASY2, DLANV2, DLAQTR, DLAEXC, 27*> DTRSYL, DTREXC, DTRSNA, DTRSEN, DTGEXC 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, DTREXC, DTRSNA and DTRSEN 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 DOUBLE PRECISION 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 double_eig 73* 74* ===================================================================== 75 SUBROUTINE DCHKEC( 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION RTRSEN( 3 ), RTRSNA( 3 ) 104* .. 105* .. External Subroutines .. 106 EXTERNAL DERREC, DGET31, DGET32, DGET33, DGET34, DGET35, 107 $ DGET36, DGET37, DGET38, DGET39, DGET40 108* .. 109* .. External Functions .. 110 DOUBLE PRECISION DLAMCH 111 EXTERNAL DLAMCH 112* .. 113* .. Executable Statements .. 114* 115 PATH( 1: 1 ) = 'Double precision' 116 PATH( 2: 3 ) = 'EC' 117 EPS = DLAMCH( 'P' ) 118 SFMIN = DLAMCH( '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 DERREC( PATH, NOUT ) 130* 131 OK = .TRUE. 132 CALL DGET31( 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 DGET32( 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 DGET33( 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 DGET34( 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 DGET35( 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 DGET36( 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 DGET37( 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 DGET38( 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 DGET39( 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 DGET40( 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 + KTGEXC 198 IF( OK ) 199 $ WRITE( NOUT, FMT = 9990 )PATH, NTESTS 200* 201 RETURN 202 9999 FORMAT( ' Error in DLALN2: RMAX =', D12.3, / ' LMAX = ', I8, ' N', 203 $ 'INFO=', 2I8, ' KNT=', I8 ) 204 9998 FORMAT( ' Error in DLASY2: RMAX =', D12.3, / ' LMAX = ', I8, ' N', 205 $ 'INFO=', I8, ' KNT=', I8 ) 206 9997 FORMAT( ' Error in DLANV2: RMAX =', D12.3, / ' LMAX = ', I8, ' N', 207 $ 'INFO=', I8, ' KNT=', I8 ) 208 9996 FORMAT( ' Error in DLAEXC: RMAX =', D12.3, / ' LMAX = ', I8, ' N', 209 $ 'INFO=', 2I8, ' KNT=', I8 ) 210 9995 FORMAT( ' Error in DTRSYL: RMAX =', D12.3, / ' LMAX = ', I8, ' N', 211 $ 'INFO=', I8, ' KNT=', I8 ) 212 9994 FORMAT( ' Error in DTREXC: RMAX =', D12.3, / ' LMAX = ', I8, ' N', 213 $ 'INFO=', 3I8, ' KNT=', I8 ) 214 9993 FORMAT( ' Error in DTRSNA: RMAX =', 3D12.3, / ' LMAX = ', 3I8, 215 $ ' NINFO=', 3I8, ' KNT=', I8 ) 216 9992 FORMAT( ' Error in DTRSEN: RMAX =', 3D12.3, / ' LMAX = ', 3I8, 217 $ ' NINFO=', 3I8, ' KNT=', I8 ) 218 9991 FORMAT( ' Error in DLAQTR: RMAX =', D12.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', / ' DLALN2, DLASY2, DLANV2, DLAEXC, DTRS', 224 $ 'YL, DTREXC, DTRSNA, DTRSEN, DLAQTR, DTGEXC', / ) 225 9988 FORMAT( ' Relative machine precision (EPS) = ', D16.6, / ' Safe ', 226 $ 'minimum (SFMIN) = ', D16.6, / ) 227 9987 FORMAT( ' Routines pass computational tests if test ratio is les', 228 $ 's than', F8.2, / / ) 229 9986 FORMAT( ' Error in DTGEXC: RMAX =', D12.3, / ' LMAX = ', I8, ' N', 230 $ 'INFO=', I8, ' KNT=', I8 ) 231* 232* End of DCHKEC 233* 234 END 235