|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE CCHKEC( THRESH, TSTERR, NIN, NOUT ) 00002 * 00003 * -- LAPACK test routine (version 3.1) -- 00004 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00005 * November 2006 00006 * 00007 * .. Scalar Arguments .. 00008 LOGICAL TSTERR 00009 INTEGER NIN, NOUT 00010 REAL THRESH 00011 * .. 00012 * 00013 * Purpose 00014 * ======= 00015 * 00016 * CCHKEC tests eigen- condition estimation routines 00017 * CTRSYL, CTREXC, CTRSNA, CTRSEN 00018 * 00019 * In all cases, the routine runs through a fixed set of numerical 00020 * examples, subjects them to various tests, and compares the test 00021 * results to a threshold THRESH. In addition, CTRSNA and CTRSEN are 00022 * tested by reading in precomputed examples from a file (on input unit 00023 * NIN). Output is written to output unit NOUT. 00024 * 00025 * Arguments 00026 * ========= 00027 * 00028 * THRESH (input) REAL 00029 * Threshold for residual tests. A computed test ratio passes 00030 * the threshold if it is less than THRESH. 00031 * 00032 * TSTERR (input) LOGICAL 00033 * Flag that indicates whether error exits are to be tested. 00034 * 00035 * NIN (input) INTEGER 00036 * The logical unit number for input. 00037 * 00038 * NOUT (input) INTEGER 00039 * The logical unit number for output. 00040 * 00041 * ===================================================================== 00042 * 00043 * .. Local Scalars .. 00044 LOGICAL OK 00045 CHARACTER*3 PATH 00046 INTEGER KTREXC, KTRSEN, KTRSNA, KTRSYL, LTREXC, LTRSYL, 00047 $ NTESTS, NTREXC, NTRSYL 00048 REAL EPS, RTREXC, RTRSYL, SFMIN 00049 * .. 00050 * .. Local Arrays .. 00051 INTEGER LTRSEN( 3 ), LTRSNA( 3 ), NTRSEN( 3 ), 00052 $ NTRSNA( 3 ) 00053 REAL RTRSEN( 3 ), RTRSNA( 3 ) 00054 * .. 00055 * .. External Subroutines .. 00056 EXTERNAL CERREC, CGET35, CGET36, CGET37, CGET38 00057 * .. 00058 * .. External Functions .. 00059 REAL SLAMCH 00060 EXTERNAL SLAMCH 00061 * .. 00062 * .. Executable Statements .. 00063 * 00064 PATH( 1: 1 ) = 'Complex precision' 00065 PATH( 2: 3 ) = 'EC' 00066 EPS = SLAMCH( 'P' ) 00067 SFMIN = SLAMCH( 'S' ) 00068 WRITE( NOUT, FMT = 9994 ) 00069 WRITE( NOUT, FMT = 9993 )EPS, SFMIN 00070 WRITE( NOUT, FMT = 9992 )THRESH 00071 * 00072 * Test error exits if TSTERR is .TRUE. 00073 * 00074 IF( TSTERR ) 00075 $ CALL CERREC( PATH, NOUT ) 00076 * 00077 OK = .TRUE. 00078 CALL CGET35( RTRSYL, LTRSYL, NTRSYL, KTRSYL, NIN ) 00079 IF( RTRSYL.GT.THRESH ) THEN 00080 OK = .FALSE. 00081 WRITE( NOUT, FMT = 9999 )RTRSYL, LTRSYL, NTRSYL, KTRSYL 00082 END IF 00083 * 00084 CALL CGET36( RTREXC, LTREXC, NTREXC, KTREXC, NIN ) 00085 IF( RTREXC.GT.THRESH .OR. NTREXC.GT.0 ) THEN 00086 OK = .FALSE. 00087 WRITE( NOUT, FMT = 9998 )RTREXC, LTREXC, NTREXC, KTREXC 00088 END IF 00089 * 00090 CALL CGET37( RTRSNA, LTRSNA, NTRSNA, KTRSNA, NIN ) 00091 IF( RTRSNA( 1 ).GT.THRESH .OR. RTRSNA( 2 ).GT.THRESH .OR. 00092 $ NTRSNA( 1 ).NE.0 .OR. NTRSNA( 2 ).NE.0 .OR. NTRSNA( 3 ).NE.0 ) 00093 $ THEN 00094 OK = .FALSE. 00095 WRITE( NOUT, FMT = 9997 )RTRSNA, LTRSNA, NTRSNA, KTRSNA 00096 END IF 00097 * 00098 CALL CGET38( RTRSEN, LTRSEN, NTRSEN, KTRSEN, NIN ) 00099 IF( RTRSEN( 1 ).GT.THRESH .OR. RTRSEN( 2 ).GT.THRESH .OR. 00100 $ NTRSEN( 1 ).NE.0 .OR. NTRSEN( 2 ).NE.0 .OR. NTRSEN( 3 ).NE.0 ) 00101 $ THEN 00102 OK = .FALSE. 00103 WRITE( NOUT, FMT = 9996 )RTRSEN, LTRSEN, NTRSEN, KTRSEN 00104 END IF 00105 * 00106 NTESTS = KTRSYL + KTREXC + KTRSNA + KTRSEN 00107 IF( OK ) 00108 $ WRITE( NOUT, FMT = 9995 )PATH, NTESTS 00109 * 00110 9999 FORMAT( ' Error in CTRSYL: RMAX =', E12.3, / ' LMAX = ', I8, 00111 $ ' NINFO=', I8, ' KNT=', I8 ) 00112 9998 FORMAT( ' Error in CTREXC: RMAX =', E12.3, / ' LMAX = ', I8, 00113 $ ' NINFO=', I8, ' KNT=', I8 ) 00114 9997 FORMAT( ' Error in CTRSNA: RMAX =', 3E12.3, / ' LMAX = ', 00115 $ 3I8, ' NINFO=', 3I8, ' KNT=', I8 ) 00116 9996 FORMAT( ' Error in CTRSEN: RMAX =', 3E12.3, / ' LMAX = ', 00117 $ 3I8, ' NINFO=', 3I8, ' KNT=', I8 ) 00118 9995 FORMAT( / 1X, 'All tests for ', A3, 00119 $ ' routines passed the threshold (', I6, ' tests run)' ) 00120 9994 FORMAT( ' Tests of the Nonsymmetric eigenproblem condition', 00121 $ ' estimation routines', / ' CTRSYL, CTREXC, CTRSNA, CTRSEN', 00122 $ / ) 00123 9993 FORMAT( ' Relative machine precision (EPS) = ', E16.6, 00124 $ / ' Safe minimum (SFMIN) = ', E16.6, / ) 00125 9992 FORMAT( ' Routines pass computational tests if test ratio is ', 00126 $ 'less than', F8.2, / / ) 00127 RETURN 00128 * 00129 * End of CCHKEC 00130 * 00131 END
1.7.3 
