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