1*> \brief \b DCHKRFP 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 DCHKRFP 12* 13* 14*> \par Purpose: 15* ============= 16*> 17*> \verbatim 18*> 19*> DCHKRFP is the main test program for the DOUBLE PRECISION 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 double_lin 56* 57* ===================================================================== 58 PROGRAM DCHKRFP 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 DOUBLE PRECISION EPS, S1, S2, THRESH 83 84* .. 85* .. Local Arrays .. 86 INTEGER NVAL( MAXIN ), NSVAL( MAXIN ), NTVAL( NTYPES ) 87 DOUBLE PRECISION WORKA( NMAX, NMAX ) 88 DOUBLE PRECISION WORKASAV( NMAX, NMAX ) 89 DOUBLE PRECISION WORKB( NMAX, MAXRHS ) 90 DOUBLE PRECISION WORKXACT( NMAX, MAXRHS ) 91 DOUBLE PRECISION WORKBSAV( NMAX, MAXRHS ) 92 DOUBLE PRECISION WORKX( NMAX, MAXRHS ) 93 DOUBLE PRECISION WORKAFAC( NMAX, NMAX ) 94 DOUBLE PRECISION WORKAINV( NMAX, NMAX ) 95 DOUBLE PRECISION WORKARF( (NMAX*(NMAX+1))/2 ) 96 DOUBLE PRECISION WORKAP( (NMAX*(NMAX+1))/2 ) 97 DOUBLE PRECISION WORKARFINV( (NMAX*(NMAX+1))/2 ) 98 DOUBLE PRECISION D_WORK_DLATMS( 3 * NMAX ) 99 DOUBLE PRECISION D_WORK_DPOT01( NMAX ) 100 DOUBLE PRECISION D_TEMP_DPOT02( NMAX, MAXRHS ) 101 DOUBLE PRECISION D_TEMP_DPOT03( NMAX, NMAX ) 102 DOUBLE PRECISION D_WORK_DLANSY( NMAX ) 103 DOUBLE PRECISION D_WORK_DPOT02( NMAX ) 104 DOUBLE PRECISION D_WORK_DPOT03( NMAX ) 105* .. 106* .. External Functions .. 107 DOUBLE PRECISION DLAMCH, DSECND 108 EXTERNAL DLAMCH, DSECND 109* .. 110* .. External Subroutines .. 111 EXTERNAL ILAVER, DDRVRFP, DDRVRF1, DDRVRF2, DDRVRF3, 112 + DDRVRF4 113* .. 114* .. Executable Statements .. 115* 116 S1 = DSECND( ) 117 FATAL = .FALSE. 118* 119* Read a dummy line. 120* 121 READ( NIN, FMT = * ) 122* 123* Report LAPACK version tag (e.g. LAPACK-3.2.0) 124* 125 CALL ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH ) 126 WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH 127* 128* Read the values of N 129* 130 READ( NIN, FMT = * )NN 131 IF( NN.LT.1 ) THEN 132 WRITE( NOUT, FMT = 9996 )' NN ', NN, 1 133 NN = 0 134 FATAL = .TRUE. 135 ELSE IF( NN.GT.MAXIN ) THEN 136 WRITE( NOUT, FMT = 9995 )' NN ', NN, MAXIN 137 NN = 0 138 FATAL = .TRUE. 139 END IF 140 READ( NIN, FMT = * )( NVAL( I ), I = 1, NN ) 141 DO 10 I = 1, NN 142 IF( NVAL( I ).LT.0 ) THEN 143 WRITE( NOUT, FMT = 9996 )' M ', NVAL( I ), 0 144 FATAL = .TRUE. 145 ELSE IF( NVAL( I ).GT.NMAX ) THEN 146 WRITE( NOUT, FMT = 9995 )' M ', NVAL( I ), NMAX 147 FATAL = .TRUE. 148 END IF 149 10 CONTINUE 150 IF( NN.GT.0 ) 151 $ WRITE( NOUT, FMT = 9993 )'N ', ( NVAL( I ), I = 1, NN ) 152* 153* Read the values of NRHS 154* 155 READ( NIN, FMT = * )NNS 156 IF( NNS.LT.1 ) THEN 157 WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1 158 NNS = 0 159 FATAL = .TRUE. 160 ELSE IF( NNS.GT.MAXIN ) THEN 161 WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN 162 NNS = 0 163 FATAL = .TRUE. 164 END IF 165 READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS ) 166 DO 30 I = 1, NNS 167 IF( NSVAL( I ).LT.0 ) THEN 168 WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0 169 FATAL = .TRUE. 170 ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN 171 WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS 172 FATAL = .TRUE. 173 END IF 174 30 CONTINUE 175 IF( NNS.GT.0 ) 176 $ WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS ) 177* 178* Read the matrix types 179* 180 READ( NIN, FMT = * )NNT 181 IF( NNT.LT.1 ) THEN 182 WRITE( NOUT, FMT = 9996 )' NMA', NNT, 1 183 NNT = 0 184 FATAL = .TRUE. 185 ELSE IF( NNT.GT.NTYPES ) THEN 186 WRITE( NOUT, FMT = 9995 )' NMA', NNT, NTYPES 187 NNT = 0 188 FATAL = .TRUE. 189 END IF 190 READ( NIN, FMT = * )( NTVAL( I ), I = 1, NNT ) 191 DO 320 I = 1, NNT 192 IF( NTVAL( I ).LT.0 ) THEN 193 WRITE( NOUT, FMT = 9996 )'TYPE', NTVAL( I ), 0 194 FATAL = .TRUE. 195 ELSE IF( NTVAL( I ).GT.NTYPES ) THEN 196 WRITE( NOUT, FMT = 9995 )'TYPE', NTVAL( I ), NTYPES 197 FATAL = .TRUE. 198 END IF 199 320 CONTINUE 200 IF( NNT.GT.0 ) 201 $ WRITE( NOUT, FMT = 9993 )'TYPE', ( NTVAL( I ), I = 1, NNT ) 202* 203* Read the threshold value for the test ratios. 204* 205 READ( NIN, FMT = * )THRESH 206 WRITE( NOUT, FMT = 9992 )THRESH 207* 208* Read the flag that indicates whether to test the error exits. 209* 210 READ( NIN, FMT = * )TSTERR 211* 212 IF( FATAL ) THEN 213 WRITE( NOUT, FMT = 9999 ) 214 STOP 215 END IF 216* 217* Calculate and print the machine dependent constants. 218* 219 EPS = DLAMCH( 'Underflow threshold' ) 220 WRITE( NOUT, FMT = 9991 )'underflow', EPS 221 EPS = DLAMCH( 'Overflow threshold' ) 222 WRITE( NOUT, FMT = 9991 )'overflow ', EPS 223 EPS = DLAMCH( 'Epsilon' ) 224 WRITE( NOUT, FMT = 9991 )'precision', EPS 225 WRITE( NOUT, FMT = * ) 226* 227* Test the error exit of: 228* 229 IF( TSTERR ) 230 $ CALL DERRRFP( NOUT ) 231* 232* Test the routines: dpftrf, dpftri, dpftrs (as in DDRVPO). 233* This also tests the routines: dtfsm, dtftri, dtfttr, dtrttf. 234* 235 CALL DDRVRFP( NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL, THRESH, 236 $ WORKA, WORKASAV, WORKAFAC, WORKAINV, WORKB, 237 $ WORKBSAV, WORKXACT, WORKX, WORKARF, WORKARFINV, 238 $ D_WORK_DLATMS, D_WORK_DPOT01, D_TEMP_DPOT02, 239 $ D_TEMP_DPOT03, D_WORK_DLANSY, D_WORK_DPOT02, 240 $ D_WORK_DPOT03 ) 241* 242* Test the routine: dlansf 243* 244 CALL DDRVRF1( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF, 245 + D_WORK_DLANSY ) 246* 247* Test the conversion routines: 248* dtfttp, dtpttf, dtfttr, dtrttf, dtrttp and dtpttr. 249* 250 CALL DDRVRF2( NOUT, NN, NVAL, WORKA, NMAX, WORKARF, 251 + WORKAP, WORKASAV ) 252* 253* Test the routine: dtfsm 254* 255 CALL DDRVRF3( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF, 256 + WORKAINV, WORKAFAC, D_WORK_DLANSY, 257 + D_WORK_DPOT03, D_WORK_DPOT01 ) 258* 259* 260* Test the routine: dsfrk 261* 262 CALL DDRVRF4( NOUT, NN, NVAL, THRESH, WORKA, WORKAFAC, NMAX, 263 + WORKARF, WORKAINV, NMAX, D_WORK_DLANSY) 264* 265 CLOSE ( NIN ) 266 S2 = DSECND( ) 267 WRITE( NOUT, FMT = 9998 ) 268 WRITE( NOUT, FMT = 9997 )S2 - S1 269* 270 9999 FORMAT( / ' Execution not attempted due to input errors' ) 271 9998 FORMAT( / ' End of tests' ) 272 9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / ) 273 9996 FORMAT( ' !! Invalid input value: ', A4, '=', I6, '; must be >=', 274 $ I6 ) 275 9995 FORMAT( ' !! Invalid input value: ', A4, '=', I6, '; must be <=', 276 $ I6 ) 277 9994 FORMAT( / ' Tests of the DOUBLE PRECISION LAPACK RFP routines ', 278 $ / ' LAPACK VERSION ', I1, '.', I1, '.', I1, 279 $ / / ' The following parameter values will be used:' ) 280 9993 FORMAT( 4X, A4, ': ', 10I6, / 11X, 10I6 ) 281 9992 FORMAT( / ' Routines pass computational tests if test ratio is ', 282 $ 'less than', F8.2, / ) 283 9991 FORMAT( ' Relative machine ', A, ' is taken to be', D16.6 ) 284* 285* End of DCHKRFP 286* 287 END 288