 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 PROGRAM DCHKRFP 00002 IMPLICIT NONE 00003 * 00004 * -- LAPACK test routine (version 3.2.0) -- 00005 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00006 * November 2008 00007 * 00008 * Purpose 00009 * ======= 00010 * 00011 * DCHKRFP is the main test program for the DOUBLE PRECISION linear 00012 * equation routines with RFP storage format 00013 * 00014 * 00015 * Internal Parameters 00016 * =================== 00017 * 00018 * MAXIN INTEGER 00019 * The number of different values that can be used for each of 00020 * M, N, or NB 00021 * 00022 * MAXRHS INTEGER 00023 * The maximum number of right hand sides 00024 * 00025 * NTYPES INTEGER 00026 * 00027 * NMAX INTEGER 00028 * The maximum allowable value for N. 00029 * 00030 * NIN INTEGER 00031 * The unit number for input 00032 * 00033 * NOUT INTEGER 00034 * The unit number for output 00035 * 00036 * ===================================================================== 00037 * 00038 * .. Parameters .. 00039 INTEGER MAXIN 00040 PARAMETER ( MAXIN = 12 ) 00041 INTEGER NMAX 00042 PARAMETER ( NMAX = 50 ) 00043 INTEGER MAXRHS 00044 PARAMETER ( MAXRHS = 16 ) 00045 INTEGER NTYPES 00046 PARAMETER ( NTYPES = 9 ) 00047 INTEGER NIN, NOUT 00048 PARAMETER ( NIN = 5, NOUT = 6 ) 00049 * .. 00050 * .. Local Scalars .. 00051 LOGICAL FATAL, TSTERR 00052 INTEGER VERS_MAJOR, VERS_MINOR, VERS_PATCH 00053 INTEGER I, NN, NNS, NNT 00054 DOUBLE PRECISION EPS, S1, S2, THRESH 00055 00056 * .. 00057 * .. Local Arrays .. 00058 INTEGER NVAL( MAXIN ), NSVAL( MAXIN ), NTVAL( NTYPES ) 00059 DOUBLE PRECISION WORKA( NMAX, NMAX ) 00060 DOUBLE PRECISION WORKASAV( NMAX, NMAX ) 00061 DOUBLE PRECISION WORKB( NMAX, MAXRHS ) 00062 DOUBLE PRECISION WORKXACT( NMAX, MAXRHS ) 00063 DOUBLE PRECISION WORKBSAV( NMAX, MAXRHS ) 00064 DOUBLE PRECISION WORKX( NMAX, MAXRHS ) 00065 DOUBLE PRECISION WORKAFAC( NMAX, NMAX ) 00066 DOUBLE PRECISION WORKAINV( NMAX, NMAX ) 00067 DOUBLE PRECISION WORKARF( (NMAX*(NMAX+1))/2 ) 00068 DOUBLE PRECISION WORKAP( (NMAX*(NMAX+1))/2 ) 00069 DOUBLE PRECISION WORKARFINV( (NMAX*(NMAX+1))/2 ) 00070 DOUBLE PRECISION D_WORK_DLATMS( 3 * NMAX ) 00071 DOUBLE PRECISION D_WORK_DPOT01( NMAX ) 00072 DOUBLE PRECISION D_TEMP_DPOT02( NMAX, MAXRHS ) 00073 DOUBLE PRECISION D_TEMP_DPOT03( NMAX, NMAX ) 00074 DOUBLE PRECISION D_WORK_DLANSY( NMAX ) 00075 DOUBLE PRECISION D_WORK_DPOT02( NMAX ) 00076 DOUBLE PRECISION D_WORK_DPOT03( NMAX ) 00077 * .. 00078 * .. External Functions .. 00079 DOUBLE PRECISION DLAMCH, DSECND 00080 EXTERNAL DLAMCH, DSECND 00081 * .. 00082 * .. External Subroutines .. 00083 EXTERNAL ILAVER, DDRVRFP, DDRVRF1, DDRVRF2, DDRVRF3, 00084 + DDRVRF4 00085 * .. 00086 * .. Executable Statements .. 00087 * 00088 S1 = DSECND( ) 00089 FATAL = .FALSE. 00090 * 00091 * Read a dummy line. 00092 * 00093 READ( NIN, FMT = * ) 00094 * 00095 * Report LAPACK version tag (e.g. LAPACK-3.2.0) 00096 * 00097 CALL ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH ) 00098 WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH 00099 * 00100 * Read the values of N 00101 * 00102 READ( NIN, FMT = * )NN 00103 IF( NN.LT.1 ) THEN 00104 WRITE( NOUT, FMT = 9996 )' NN ', NN, 1 00105 NN = 0 00106 FATAL = .TRUE. 00107 ELSE IF( NN.GT.MAXIN ) THEN 00108 WRITE( NOUT, FMT = 9995 )' NN ', NN, MAXIN 00109 NN = 0 00110 FATAL = .TRUE. 00111 END IF 00112 READ( NIN, FMT = * )( NVAL( I ), I = 1, NN ) 00113 DO 10 I = 1, NN 00114 IF( NVAL( I ).LT.0 ) THEN 00115 WRITE( NOUT, FMT = 9996 )' M ', NVAL( I ), 0 00116 FATAL = .TRUE. 00117 ELSE IF( NVAL( I ).GT.NMAX ) THEN 00118 WRITE( NOUT, FMT = 9995 )' M ', NVAL( I ), NMAX 00119 FATAL = .TRUE. 00120 END IF 00121 10 CONTINUE 00122 IF( NN.GT.0 ) 00123 $ WRITE( NOUT, FMT = 9993 )'N ', ( NVAL( I ), I = 1, NN ) 00124 * 00125 * Read the values of NRHS 00126 * 00127 READ( NIN, FMT = * )NNS 00128 IF( NNS.LT.1 ) THEN 00129 WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1 00130 NNS = 0 00131 FATAL = .TRUE. 00132 ELSE IF( NNS.GT.MAXIN ) THEN 00133 WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN 00134 NNS = 0 00135 FATAL = .TRUE. 00136 END IF 00137 READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS ) 00138 DO 30 I = 1, NNS 00139 IF( NSVAL( I ).LT.0 ) THEN 00140 WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0 00141 FATAL = .TRUE. 00142 ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN 00143 WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS 00144 FATAL = .TRUE. 00145 END IF 00146 30 CONTINUE 00147 IF( NNS.GT.0 ) 00148 $ WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS ) 00149 * 00150 * Read the matrix types 00151 * 00152 READ( NIN, FMT = * )NNT 00153 IF( NNT.LT.1 ) THEN 00154 WRITE( NOUT, FMT = 9996 )' NMA', NNT, 1 00155 NNT = 0 00156 FATAL = .TRUE. 00157 ELSE IF( NNT.GT.NTYPES ) THEN 00158 WRITE( NOUT, FMT = 9995 )' NMA', NNT, NTYPES 00159 NNT = 0 00160 FATAL = .TRUE. 00161 END IF 00162 READ( NIN, FMT = * )( NTVAL( I ), I = 1, NNT ) 00163 DO 320 I = 1, NNT 00164 IF( NTVAL( I ).LT.0 ) THEN 00165 WRITE( NOUT, FMT = 9996 )'TYPE', NTVAL( I ), 0 00166 FATAL = .TRUE. 00167 ELSE IF( NTVAL( I ).GT.NTYPES ) THEN 00168 WRITE( NOUT, FMT = 9995 )'TYPE', NTVAL( I ), NTYPES 00169 FATAL = .TRUE. 00170 END IF 00171 320 CONTINUE 00172 IF( NNT.GT.0 ) 00173 $ WRITE( NOUT, FMT = 9993 )'TYPE', ( NTVAL( I ), I = 1, NNT ) 00174 * 00175 * Read the threshold value for the test ratios. 00176 * 00177 READ( NIN, FMT = * )THRESH 00178 WRITE( NOUT, FMT = 9992 )THRESH 00179 * 00180 * Read the flag that indicates whether to test the error exits. 00181 * 00182 READ( NIN, FMT = * )TSTERR 00183 * 00184 IF( FATAL ) THEN 00185 WRITE( NOUT, FMT = 9999 ) 00186 STOP 00187 END IF 00188 * 00189 IF( FATAL ) THEN 00190 WRITE( NOUT, FMT = 9999 ) 00191 STOP 00192 END IF 00193 * 00194 * Calculate and print the machine dependent constants. 00195 * 00196 EPS = DLAMCH( 'Underflow threshold' ) 00197 WRITE( NOUT, FMT = 9991 )'underflow', EPS 00198 EPS = DLAMCH( 'Overflow threshold' ) 00199 WRITE( NOUT, FMT = 9991 )'overflow ', EPS 00200 EPS = DLAMCH( 'Epsilon' ) 00201 WRITE( NOUT, FMT = 9991 )'precision', EPS 00202 WRITE( NOUT, FMT = * ) 00203 * 00204 * Test the error exit of: 00205 * 00206 IF( TSTERR ) 00207 $ CALL DERRRFP( NOUT ) 00208 * 00209 * Test the routines: dpftrf, dpftri, dpftrs (as in DDRVPO). 00210 * This also tests the routines: dtfsm, dtftri, dtfttr, dtrttf. 00211 * 00212 CALL DDRVRFP( NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL, THRESH, 00213 $ WORKA, WORKASAV, WORKAFAC, WORKAINV, WORKB, 00214 $ WORKBSAV, WORKXACT, WORKX, WORKARF, WORKARFINV, 00215 $ D_WORK_DLATMS, D_WORK_DPOT01, D_TEMP_DPOT02, 00216 $ D_TEMP_DPOT03, D_WORK_DLANSY, D_WORK_DPOT02, 00217 $ D_WORK_DPOT03 ) 00218 * 00219 * Test the routine: dlansf 00220 * 00221 CALL DDRVRF1( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF, 00222 + D_WORK_DLANSY ) 00223 * 00224 * Test the convertion routines: 00225 * dtfttp, dtpttf, dtfttr, dtrttf, dtrttp and dtpttr. 00226 * 00227 CALL DDRVRF2( NOUT, NN, NVAL, WORKA, NMAX, WORKARF, 00228 + WORKAP, WORKASAV ) 00229 * 00230 * Test the routine: dtfsm 00231 * 00232 CALL DDRVRF3( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF, 00233 + WORKAINV, WORKAFAC, D_WORK_DLANSY, 00234 + D_WORK_DPOT03, D_WORK_DPOT01 ) 00235 * 00236 * 00237 * Test the routine: dsfrk 00238 * 00239 CALL DDRVRF4( NOUT, NN, NVAL, THRESH, WORKA, WORKAFAC, NMAX, 00240 + WORKARF, WORKAINV, NMAX, D_WORK_DLANSY) 00241 * 00242 CLOSE ( NIN ) 00243 S2 = DSECND( ) 00244 WRITE( NOUT, FMT = 9998 ) 00245 WRITE( NOUT, FMT = 9997 )S2 - S1 00246 * 00247 9999 FORMAT( / ' Execution not attempted due to input errors' ) 00248 9998 FORMAT( / ' End of tests' ) 00249 9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / ) 00250 9996 FORMAT( ' !! Invalid input value: ', A4, '=', I6, '; must be >=', 00251 $ I6 ) 00252 9995 FORMAT( ' !! Invalid input value: ', A4, '=', I6, '; must be <=', 00253 $ I6 ) 00254 9994 FORMAT( / ' Tests of the DOUBLE PRECISION LAPACK RFP routines ', 00255 $ / ' LAPACK VERSION ', I1, '.', I1, '.', I1, 00256 $ / / ' The following parameter values will be used:' ) 00257 9993 FORMAT( 4X, A4, ': ', 10I6, / 11X, 10I6 ) 00258 9992 FORMAT( / ' Routines pass computational tests if test ratio is ', 00259 $ 'less than', F8.2, / ) 00260 9991 FORMAT( ' Relative machine ', A, ' is taken to be', D16.6 ) 00261 * 00262 * End of DCHKRFP 00263 * 00264 END
1.7.3 
