|
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 SCHKEC( 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 REAL THRESH * .. * * Purpose * ======= * * SCHKEC tests eigen- condition estimation routines * SLALN2, SLASY2, SLANV2, SLAQTR, SLAEXC, * STRSYL, STREXC, STRSNA, STRSEN * * 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, STREXC, STRSNA and STRSEN * are tested by reading in precomputed examples from a file (on input * unit NIN). Output is written to output unit NOUT. * * Arguments * ========= * * THRESH (input) REAL * 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 REAL 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 ) REAL RTRSEN( 3 ), RTRSNA( 3 ) * .. * .. External Subroutines .. EXTERNAL SERREC, SGET31, SGET32, SGET33, SGET34, SGET35, $ SGET36, SGET37, SGET38, SGET39 * .. * .. External Functions .. REAL SLAMCH EXTERNAL SLAMCH * .. * .. Executable Statements .. * PATH( 1: 1 ) = 'Single precision' PATH( 2: 3 ) = 'EC' EPS = SLAMCH( 'P' ) SFMIN = SLAMCH( '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 SERREC( PATH, NOUT ) * OK = .TRUE. CALL SGET31( 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 SGET32( RLASY2, LLASY2, NLASY2, KLASY2 ) IF( RLASY2.GT.THRESH ) THEN OK = .FALSE. WRITE( NOUT, FMT = 9998 )RLASY2, LLASY2, NLASY2, KLASY2 END IF * CALL SGET33( 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 SGET34( 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 SGET35( RTRSYL, LTRSYL, NTRSYL, KTRSYL ) IF( RTRSYL.GT.THRESH ) THEN OK = .FALSE. WRITE( NOUT, FMT = 9995 )RTRSYL, LTRSYL, NTRSYL, KTRSYL END IF * CALL SGET36( 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 SGET37( 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 SGET38( 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 SGET39( 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 SLALN2: RMAX =', E12.3, / ' LMAX = ', I8, ' N', $ 'INFO=', 2I8, ' KNT=', I8 ) 9998 FORMAT( ' Error in SLASY2: RMAX =', E12.3, / ' LMAX = ', I8, ' N', $ 'INFO=', I8, ' KNT=', I8 ) 9997 FORMAT( ' Error in SLANV2: RMAX =', E12.3, / ' LMAX = ', I8, ' N', $ 'INFO=', I8, ' KNT=', I8 ) 9996 FORMAT( ' Error in SLAEXC: RMAX =', E12.3, / ' LMAX = ', I8, ' N', $ 'INFO=', 2I8, ' KNT=', I8 ) 9995 FORMAT( ' Error in STRSYL: RMAX =', E12.3, / ' LMAX = ', I8, ' N', $ 'INFO=', I8, ' KNT=', I8 ) 9994 FORMAT( ' Error in STREXC: RMAX =', E12.3, / ' LMAX = ', I8, ' N', $ 'INFO=', 3I8, ' KNT=', I8 ) 9993 FORMAT( ' Error in STRSNA: RMAX =', 3E12.3, / ' LMAX = ', 3I8, $ ' NINFO=', 3I8, ' KNT=', I8 ) 9992 FORMAT( ' Error in STRSEN: RMAX =', 3E12.3, / ' LMAX = ', 3I8, $ ' NINFO=', 3I8, ' KNT=', I8 ) 9991 FORMAT( ' Error in SLAQTR: RMAX =', E12.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', / ' SLALN2, SLASY2, SLANV2, SLAEXC, STRS', $ 'YL, STREXC, STRSNA, STRSEN, SLAQTR', / ) 9988 FORMAT( ' Relative machine precision (EPS) = ', E16.6, / ' Safe ', $ 'minimum (SFMIN) = ', E16.6, / ) 9987 FORMAT( ' Routines pass computational tests if test ratio is les', $ 's than', F8.2, / / ) * * End of SCHKEC * END |