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