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