1*> \brief \b SCHKRFP 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* PROGRAM SCHKRFP 12* 13* 14*> \par Purpose: 15* ============= 16*> 17*> \verbatim 18*> 19*> SCHKRFP is the main test program for the REAL linear 20*> equation routines with RFP storage format 21*> 22*> \endverbatim 23* 24* Arguments: 25* ========== 26* 27*> \verbatim 28*> MAXIN INTEGER 29*> The number of different values that can be used for each of 30*> M, N, or NB 31*> 32*> MAXRHS INTEGER 33*> The maximum number of right hand sides 34*> 35*> NTYPES INTEGER 36*> 37*> NMAX INTEGER 38*> The maximum allowable value for N. 39*> 40*> NIN INTEGER 41*> The unit number for input 42*> 43*> NOUT INTEGER 44*> The unit number for output 45*> \endverbatim 46* 47* Authors: 48* ======== 49* 50*> \author Univ. of Tennessee 51*> \author Univ. of California Berkeley 52*> \author Univ. of Colorado Denver 53*> \author NAG Ltd. 54* 55*> \date April 2012 56* 57*> \ingroup single_lin 58* 59* ===================================================================== 60 PROGRAM SCHKRFP 61* 62* -- LAPACK test routine (version 3.4.1) -- 63* -- LAPACK is a software package provided by Univ. of Tennessee, -- 64* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 65* April 2012 66* 67* ===================================================================== 68* 69* .. Parameters .. 70 INTEGER MAXIN 71 PARAMETER ( MAXIN = 12 ) 72 INTEGER NMAX 73 PARAMETER ( NMAX = 50 ) 74 INTEGER MAXRHS 75 PARAMETER ( MAXRHS = 16 ) 76 INTEGER NTYPES 77 PARAMETER ( NTYPES = 9 ) 78 INTEGER NIN, NOUT 79 PARAMETER ( NIN = 5, NOUT = 6 ) 80* .. 81* .. Local Scalars .. 82 LOGICAL FATAL, TSTERR 83 INTEGER VERS_MAJOR, VERS_MINOR, VERS_PATCH 84 INTEGER I, NN, NNS, NNT 85 REAL EPS, S1, S2, THRESH 86* .. 87* .. Local Arrays .. 88 INTEGER NVAL( MAXIN ), NSVAL( MAXIN ), NTVAL( NTYPES ) 89 REAL WORKA( NMAX, NMAX ) 90 REAL WORKASAV( NMAX, NMAX ) 91 REAL WORKB( NMAX, MAXRHS ) 92 REAL WORKXACT( NMAX, MAXRHS ) 93 REAL WORKBSAV( NMAX, MAXRHS ) 94 REAL WORKX( NMAX, MAXRHS ) 95 REAL WORKAFAC( NMAX, NMAX ) 96 REAL WORKAINV( NMAX, NMAX ) 97 REAL WORKARF( (NMAX*(NMAX+1))/2 ) 98 REAL WORKAP( (NMAX*(NMAX+1))/2 ) 99 REAL WORKARFINV( (NMAX*(NMAX+1))/2 ) 100 REAL S_WORK_SLATMS( 3 * NMAX ) 101 REAL S_WORK_SPOT01( NMAX ) 102 REAL S_TEMP_SPOT02( NMAX, MAXRHS ) 103 REAL S_TEMP_SPOT03( NMAX, NMAX ) 104 REAL S_WORK_SLANSY( NMAX ) 105 REAL S_WORK_SPOT02( NMAX ) 106 REAL S_WORK_SPOT03( NMAX ) 107* .. 108* .. External Functions .. 109 REAL SLAMCH, SECOND 110 EXTERNAL SLAMCH, SECOND 111* .. 112* .. External Subroutines .. 113 EXTERNAL ILAVER, SDRVRFP, SDRVRF1, SDRVRF2, SDRVRF3, 114 + SDRVRF4 115* .. 116* .. Executable Statements .. 117* 118 S1 = SECOND( ) 119 FATAL = .FALSE. 120* 121* Read a dummy line. 122* 123 READ( NIN, FMT = * ) 124* 125* Report LAPACK version tag (e.g. LAPACK-3.2.0) 126* 127 CALL ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH ) 128 WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH 129* 130* Read the values of N 131* 132 READ( NIN, FMT = * )NN 133 IF( NN.LT.1 ) THEN 134 WRITE( NOUT, FMT = 9996 )' NN ', NN, 1 135 NN = 0 136 FATAL = .TRUE. 137 ELSE IF( NN.GT.MAXIN ) THEN 138 WRITE( NOUT, FMT = 9995 )' NN ', NN, MAXIN 139 NN = 0 140 FATAL = .TRUE. 141 END IF 142 READ( NIN, FMT = * )( NVAL( I ), I = 1, NN ) 143 DO 10 I = 1, NN 144 IF( NVAL( I ).LT.0 ) THEN 145 WRITE( NOUT, FMT = 9996 )' M ', NVAL( I ), 0 146 FATAL = .TRUE. 147 ELSE IF( NVAL( I ).GT.NMAX ) THEN 148 WRITE( NOUT, FMT = 9995 )' M ', NVAL( I ), NMAX 149 FATAL = .TRUE. 150 END IF 151 10 CONTINUE 152 IF( NN.GT.0 ) 153 $ WRITE( NOUT, FMT = 9993 )'N ', ( NVAL( I ), I = 1, NN ) 154* 155* Read the values of NRHS 156* 157 READ( NIN, FMT = * )NNS 158 IF( NNS.LT.1 ) THEN 159 WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1 160 NNS = 0 161 FATAL = .TRUE. 162 ELSE IF( NNS.GT.MAXIN ) THEN 163 WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN 164 NNS = 0 165 FATAL = .TRUE. 166 END IF 167 READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS ) 168 DO 30 I = 1, NNS 169 IF( NSVAL( I ).LT.0 ) THEN 170 WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0 171 FATAL = .TRUE. 172 ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN 173 WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS 174 FATAL = .TRUE. 175 END IF 176 30 CONTINUE 177 IF( NNS.GT.0 ) 178 $ WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS ) 179* 180* Read the matrix types 181* 182 READ( NIN, FMT = * )NNT 183 IF( NNT.LT.1 ) THEN 184 WRITE( NOUT, FMT = 9996 )' NMA', NNT, 1 185 NNT = 0 186 FATAL = .TRUE. 187 ELSE IF( NNT.GT.NTYPES ) THEN 188 WRITE( NOUT, FMT = 9995 )' NMA', NNT, NTYPES 189 NNT = 0 190 FATAL = .TRUE. 191 END IF 192 READ( NIN, FMT = * )( NTVAL( I ), I = 1, NNT ) 193 DO 320 I = 1, NNT 194 IF( NTVAL( I ).LT.0 ) THEN 195 WRITE( NOUT, FMT = 9996 )'TYPE', NTVAL( I ), 0 196 FATAL = .TRUE. 197 ELSE IF( NTVAL( I ).GT.NTYPES ) THEN 198 WRITE( NOUT, FMT = 9995 )'TYPE', NTVAL( I ), NTYPES 199 FATAL = .TRUE. 200 END IF 201 320 CONTINUE 202 IF( NNT.GT.0 ) 203 $ WRITE( NOUT, FMT = 9993 )'TYPE', ( NTVAL( I ), I = 1, NNT ) 204* 205* Read the threshold value for the test ratios. 206* 207 READ( NIN, FMT = * )THRESH 208 WRITE( NOUT, FMT = 9992 )THRESH 209* 210* Read the flag that indicates whether to test the error exits. 211* 212 READ( NIN, FMT = * )TSTERR 213* 214 IF( FATAL ) THEN 215 WRITE( NOUT, FMT = 9999 ) 216 STOP 217 END IF 218* 219 IF( FATAL ) THEN 220 WRITE( NOUT, FMT = 9999 ) 221 STOP 222 END IF 223* 224* Calculate and print the machine dependent constants. 225* 226 EPS = SLAMCH( 'Underflow threshold' ) 227 WRITE( NOUT, FMT = 9991 )'underflow', EPS 228 EPS = SLAMCH( 'Overflow threshold' ) 229 WRITE( NOUT, FMT = 9991 )'overflow ', EPS 230 EPS = SLAMCH( 'Epsilon' ) 231 WRITE( NOUT, FMT = 9991 )'precision', EPS 232 WRITE( NOUT, FMT = * ) 233* 234* Test the error exit of: 235* 236 IF( TSTERR ) 237 $ CALL SERRRFP( NOUT ) 238* 239* Test the routines: spftrf, spftri, spftrs (as in SDRVPO). 240* This also tests the routines: stfsm, stftri, stfttr, strttf. 241* 242 CALL SDRVRFP( NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL, THRESH, 243 $ WORKA, WORKASAV, WORKAFAC, WORKAINV, WORKB, 244 $ WORKBSAV, WORKXACT, WORKX, WORKARF, WORKARFINV, 245 $ S_WORK_SLATMS, S_WORK_SPOT01, S_TEMP_SPOT02, 246 $ S_TEMP_SPOT03, S_WORK_SLANSY, S_WORK_SPOT02, 247 $ S_WORK_SPOT03 ) 248* 249* Test the routine: slansf 250* 251 CALL SDRVRF1( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF, 252 + S_WORK_SLANSY ) 253* 254* Test the convertion routines: 255* stfttp, stpttf, stfttr, strttf, strttp and stpttr. 256* 257 CALL SDRVRF2( NOUT, NN, NVAL, WORKA, NMAX, WORKARF, 258 + WORKAP, WORKASAV ) 259* 260* Test the routine: stfsm 261* 262 CALL SDRVRF3( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF, 263 + WORKAINV, WORKAFAC, S_WORK_SLANSY, 264 + S_WORK_SPOT03, S_WORK_SPOT01 ) 265* 266* 267* Test the routine: ssfrk 268* 269 CALL SDRVRF4( NOUT, NN, NVAL, THRESH, WORKA, WORKAFAC, NMAX, 270 + WORKARF, WORKAINV, NMAX, S_WORK_SLANSY) 271* 272 CLOSE ( NIN ) 273 S2 = SECOND( ) 274 WRITE( NOUT, FMT = 9998 ) 275 WRITE( NOUT, FMT = 9997 )S2 - S1 276* 277 9999 FORMAT( / ' Execution not attempted due to input errors' ) 278 9998 FORMAT( / ' End of tests' ) 279 9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / ) 280 9996 FORMAT( ' !! Invalid input value: ', A4, '=', I6, '; must be >=', 281 $ I6 ) 282 9995 FORMAT( ' !! Invalid input value: ', A4, '=', I6, '; must be <=', 283 $ I6 ) 284 9994 FORMAT( / ' Tests of the REAL LAPACK RFP routines ', 285 $ / ' LAPACK VERSION ', I1, '.', I1, '.', I1, 286 $ / / ' The following parameter values will be used:' ) 287 9993 FORMAT( 4X, A4, ': ', 10I6, / 11X, 10I6 ) 288 9992 FORMAT( / ' Routines pass computational tests if test ratio is ', 289 $ 'less than', F8.2, / ) 290 9991 FORMAT( ' Relative machine ', A, ' is taken to be', D16.6 ) 291* 292* End of SCHKRFP 293* 294 END 295