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