|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 PROGRAM SCHKRFP 00002 * 00003 * -- LAPACK test routine (version 3.2.0) -- 00004 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00005 * November 2008 00006 * 00007 * Purpose 00008 * ======= 00009 * 00010 * SCHKRFP is the main test program for the REAL linear 00011 * equation routines with RFP storage format 00012 * 00013 * 00014 * Internal Parameters 00015 * =================== 00016 * 00017 * MAXIN INTEGER 00018 * The number of different values that can be used for each of 00019 * M, N, or NB 00020 * 00021 * MAXRHS INTEGER 00022 * The maximum number of right hand sides 00023 * 00024 * NTYPES INTEGER 00025 * 00026 * NMAX INTEGER 00027 * The maximum allowable value for N. 00028 * 00029 * NIN INTEGER 00030 * The unit number for input 00031 * 00032 * NOUT INTEGER 00033 * The unit number for output 00034 * 00035 * ===================================================================== 00036 * 00037 * .. Parameters .. 00038 INTEGER MAXIN 00039 PARAMETER ( MAXIN = 12 ) 00040 INTEGER NMAX 00041 PARAMETER ( NMAX = 50 ) 00042 INTEGER MAXRHS 00043 PARAMETER ( MAXRHS = 16 ) 00044 INTEGER NTYPES 00045 PARAMETER ( NTYPES = 9 ) 00046 INTEGER NIN, NOUT 00047 PARAMETER ( NIN = 5, NOUT = 6 ) 00048 * .. 00049 * .. Local Scalars .. 00050 LOGICAL FATAL, TSTERR 00051 INTEGER VERS_MAJOR, VERS_MINOR, VERS_PATCH 00052 INTEGER I, NN, NNS, NNT 00053 REAL EPS, S1, S2, THRESH 00054 * .. 00055 * .. Local Arrays .. 00056 INTEGER NVAL( MAXIN ), NSVAL( MAXIN ), NTVAL( NTYPES ) 00057 REAL WORKA( NMAX, NMAX ) 00058 REAL WORKASAV( NMAX, NMAX ) 00059 REAL WORKB( NMAX, MAXRHS ) 00060 REAL WORKXACT( NMAX, MAXRHS ) 00061 REAL WORKBSAV( NMAX, MAXRHS ) 00062 REAL WORKX( NMAX, MAXRHS ) 00063 REAL WORKAFAC( NMAX, NMAX ) 00064 REAL WORKAINV( NMAX, NMAX ) 00065 REAL WORKARF( (NMAX*(NMAX+1))/2 ) 00066 REAL WORKAP( (NMAX*(NMAX+1))/2 ) 00067 REAL WORKARFINV( (NMAX*(NMAX+1))/2 ) 00068 REAL S_WORK_SLATMS( 3 * NMAX ) 00069 REAL S_WORK_SPOT01( NMAX ) 00070 REAL S_TEMP_SPOT02( NMAX, MAXRHS ) 00071 REAL S_TEMP_SPOT03( NMAX, NMAX ) 00072 REAL S_WORK_SLANSY( NMAX ) 00073 REAL S_WORK_SPOT02( NMAX ) 00074 REAL S_WORK_SPOT03( NMAX ) 00075 * .. 00076 * .. External Functions .. 00077 REAL SLAMCH, SECOND 00078 EXTERNAL SLAMCH, SECOND 00079 * .. 00080 * .. External Subroutines .. 00081 EXTERNAL ILAVER, SDRVRFP, SDRVRF1, SDRVRF2, SDRVRF3, 00082 + SDRVRF4 00083 * .. 00084 * .. Executable Statements .. 00085 * 00086 S1 = SECOND( ) 00087 FATAL = .FALSE. 00088 * 00089 * Read a dummy line. 00090 * 00091 READ( NIN, FMT = * ) 00092 * 00093 * Report LAPACK version tag (e.g. LAPACK-3.2.0) 00094 * 00095 CALL ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH ) 00096 WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH 00097 * 00098 * Read the values of N 00099 * 00100 READ( NIN, FMT = * )NN 00101 IF( NN.LT.1 ) THEN 00102 WRITE( NOUT, FMT = 9996 )' NN ', NN, 1 00103 NN = 0 00104 FATAL = .TRUE. 00105 ELSE IF( NN.GT.MAXIN ) THEN 00106 WRITE( NOUT, FMT = 9995 )' NN ', NN, MAXIN 00107 NN = 0 00108 FATAL = .TRUE. 00109 END IF 00110 READ( NIN, FMT = * )( NVAL( I ), I = 1, NN ) 00111 DO 10 I = 1, NN 00112 IF( NVAL( I ).LT.0 ) THEN 00113 WRITE( NOUT, FMT = 9996 )' M ', NVAL( I ), 0 00114 FATAL = .TRUE. 00115 ELSE IF( NVAL( I ).GT.NMAX ) THEN 00116 WRITE( NOUT, FMT = 9995 )' M ', NVAL( I ), NMAX 00117 FATAL = .TRUE. 00118 END IF 00119 10 CONTINUE 00120 IF( NN.GT.0 ) 00121 $ WRITE( NOUT, FMT = 9993 )'N ', ( NVAL( I ), I = 1, NN ) 00122 * 00123 * Read the values of NRHS 00124 * 00125 READ( NIN, FMT = * )NNS 00126 IF( NNS.LT.1 ) THEN 00127 WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1 00128 NNS = 0 00129 FATAL = .TRUE. 00130 ELSE IF( NNS.GT.MAXIN ) THEN 00131 WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN 00132 NNS = 0 00133 FATAL = .TRUE. 00134 END IF 00135 READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS ) 00136 DO 30 I = 1, NNS 00137 IF( NSVAL( I ).LT.0 ) THEN 00138 WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0 00139 FATAL = .TRUE. 00140 ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN 00141 WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS 00142 FATAL = .TRUE. 00143 END IF 00144 30 CONTINUE 00145 IF( NNS.GT.0 ) 00146 $ WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS ) 00147 * 00148 * Read the matrix types 00149 * 00150 READ( NIN, FMT = * )NNT 00151 IF( NNT.LT.1 ) THEN 00152 WRITE( NOUT, FMT = 9996 )' NMA', NNT, 1 00153 NNT = 0 00154 FATAL = .TRUE. 00155 ELSE IF( NNT.GT.NTYPES ) THEN 00156 WRITE( NOUT, FMT = 9995 )' NMA', NNT, NTYPES 00157 NNT = 0 00158 FATAL = .TRUE. 00159 END IF 00160 READ( NIN, FMT = * )( NTVAL( I ), I = 1, NNT ) 00161 DO 320 I = 1, NNT 00162 IF( NTVAL( I ).LT.0 ) THEN 00163 WRITE( NOUT, FMT = 9996 )'TYPE', NTVAL( I ), 0 00164 FATAL = .TRUE. 00165 ELSE IF( NTVAL( I ).GT.NTYPES ) THEN 00166 WRITE( NOUT, FMT = 9995 )'TYPE', NTVAL( I ), NTYPES 00167 FATAL = .TRUE. 00168 END IF 00169 320 CONTINUE 00170 IF( NNT.GT.0 ) 00171 $ WRITE( NOUT, FMT = 9993 )'TYPE', ( NTVAL( I ), I = 1, NNT ) 00172 * 00173 * Read the threshold value for the test ratios. 00174 * 00175 READ( NIN, FMT = * )THRESH 00176 WRITE( NOUT, FMT = 9992 )THRESH 00177 * 00178 * Read the flag that indicates whether to test the error exits. 00179 * 00180 READ( NIN, FMT = * )TSTERR 00181 * 00182 IF( FATAL ) THEN 00183 WRITE( NOUT, FMT = 9999 ) 00184 STOP 00185 END IF 00186 * 00187 IF( FATAL ) THEN 00188 WRITE( NOUT, FMT = 9999 ) 00189 STOP 00190 END IF 00191 * 00192 * Calculate and print the machine dependent constants. 00193 * 00194 EPS = SLAMCH( 'Underflow threshold' ) 00195 WRITE( NOUT, FMT = 9991 )'underflow', EPS 00196 EPS = SLAMCH( 'Overflow threshold' ) 00197 WRITE( NOUT, FMT = 9991 )'overflow ', EPS 00198 EPS = SLAMCH( 'Epsilon' ) 00199 WRITE( NOUT, FMT = 9991 )'precision', EPS 00200 WRITE( NOUT, FMT = * ) 00201 * 00202 * Test the error exit of: 00203 * 00204 IF( TSTERR ) 00205 $ CALL SERRRFP( NOUT ) 00206 * 00207 * Test the routines: spftrf, spftri, spftrs (as in SDRVPO). 00208 * This also tests the routines: stfsm, stftri, stfttr, strttf. 00209 * 00210 CALL SDRVRFP( NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL, THRESH, 00211 $ WORKA, WORKASAV, WORKAFAC, WORKAINV, WORKB, 00212 $ WORKBSAV, WORKXACT, WORKX, WORKARF, WORKARFINV, 00213 $ S_WORK_SLATMS, S_WORK_SPOT01, S_TEMP_SPOT02, 00214 $ S_TEMP_SPOT03, S_WORK_SLANSY, S_WORK_SPOT02, 00215 $ S_WORK_SPOT03 ) 00216 * 00217 * Test the routine: slansf 00218 * 00219 CALL SDRVRF1( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF, 00220 + S_WORK_SLANSY ) 00221 * 00222 * Test the convertion routines: 00223 * stfttp, stpttf, stfttr, strttf, strttp and stpttr. 00224 * 00225 CALL SDRVRF2( NOUT, NN, NVAL, WORKA, NMAX, WORKARF, 00226 + WORKAP, WORKASAV ) 00227 * 00228 * Test the routine: stfsm 00229 * 00230 CALL SDRVRF3( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF, 00231 + WORKAINV, WORKAFAC, S_WORK_SLANSY, 00232 + S_WORK_SPOT03, S_WORK_SPOT01 ) 00233 * 00234 * 00235 * Test the routine: ssfrk 00236 * 00237 CALL SDRVRF4( NOUT, NN, NVAL, THRESH, WORKA, WORKAFAC, NMAX, 00238 + WORKARF, WORKAINV, NMAX, S_WORK_SLANSY) 00239 * 00240 CLOSE ( NIN ) 00241 S2 = SECOND( ) 00242 WRITE( NOUT, FMT = 9998 ) 00243 WRITE( NOUT, FMT = 9997 )S2 - S1 00244 * 00245 9999 FORMAT( / ' Execution not attempted due to input errors' ) 00246 9998 FORMAT( / ' End of tests' ) 00247 9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / ) 00248 9996 FORMAT( ' !! Invalid input value: ', A4, '=', I6, '; must be >=', 00249 $ I6 ) 00250 9995 FORMAT( ' !! Invalid input value: ', A4, '=', I6, '; must be <=', 00251 $ I6 ) 00252 9994 FORMAT( / ' Tests of the REAL LAPACK RFP routines ', 00253 $ / ' LAPACK VERSION ', I1, '.', I1, '.', I1, 00254 $ / / ' The following parameter values will be used:' ) 00255 9993 FORMAT( 4X, A4, ': ', 10I6, / 11X, 10I6 ) 00256 9992 FORMAT( / ' Routines pass computational tests if test ratio is ', 00257 $ 'less than', F8.2, / ) 00258 9991 FORMAT( ' Relative machine ', A, ' is taken to be', D16.6 ) 00259 * 00260 * End of SCHKRFP 00261 * 00262 END
1.7.3 
