 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 PROGRAM DCHKAB 00002 IMPLICIT NONE 00003 * 00004 * -- LAPACK test routine (version 3.2.1) -- 00005 * 00006 * -- April 2009 -- 00007 * 00008 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00009 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00010 * 00011 * Purpose 00012 * ======= 00013 * 00014 * DCHKAB is the test program for the DOUBLE PRECISION LAPACK 00015 * DSGESV/DSPOSV routine 00016 * 00017 * The program must be driven by a short data file. The first 5 records 00018 * specify problem dimensions and program options using list-directed 00019 * input. The remaining lines specify the LAPACK test paths and the 00020 * number of matrix types to use in testing. An annotated example of a 00021 * data file can be obtained by deleting the first 3 characters from the 00022 * following 10 lines: 00023 * Data file for testing DOUBLE PRECISION LAPACK DSGESV 00024 * 7 Number of values of M 00025 * 0 1 2 3 5 10 16 Values of M (row dimension) 00026 * 1 Number of values of NRHS 00027 * 2 Values of NRHS (number of right hand sides) 00028 * 20.0 Threshold value of test ratio 00029 * T Put T to test the LAPACK routines 00030 * T Put T to test the error exits 00031 * DGE 11 List types on next line if 0 < NTYPES < 11 00032 * DPO 9 List types on next line if 0 < NTYPES < 9 00033 * 00034 * Internal Parameters 00035 * =================== 00036 * 00037 * NMAX INTEGER 00038 * The maximum allowable value for N 00039 * 00040 * MAXIN INTEGER 00041 * The number of different values that can be used for each of 00042 * M, N, NRHS, NB, and NX 00043 * 00044 * MAXRHS INTEGER 00045 * The maximum number of right hand sides 00046 * 00047 * NIN INTEGER 00048 * The unit number for input 00049 * 00050 * NOUT INTEGER 00051 * The unit number for output 00052 * 00053 * ===================================================================== 00054 * 00055 * .. Parameters .. 00056 INTEGER NMAX 00057 PARAMETER ( NMAX = 132 ) 00058 INTEGER MAXIN 00059 PARAMETER ( MAXIN = 12 ) 00060 INTEGER MAXRHS 00061 PARAMETER ( MAXRHS = 16 ) 00062 INTEGER MATMAX 00063 PARAMETER ( MATMAX = 30 ) 00064 INTEGER NIN, NOUT 00065 PARAMETER ( NIN = 5, NOUT = 6 ) 00066 INTEGER LDAMAX 00067 PARAMETER ( LDAMAX = NMAX ) 00068 * .. 00069 * .. Local Scalars .. 00070 LOGICAL FATAL, TSTDRV, TSTERR 00071 CHARACTER C1 00072 CHARACTER*2 C2 00073 CHARACTER*3 PATH 00074 CHARACTER*10 INTSTR 00075 CHARACTER*72 ALINE 00076 INTEGER I, IC, K, LDA, NM, NMATS, 00077 $ NNS, NRHS, NTYPES, 00078 $ VERS_MAJOR, VERS_MINOR, VERS_PATCH 00079 DOUBLE PRECISION EPS, S1, S2, THRESH 00080 REAL SEPS 00081 * .. 00082 * .. Local Arrays .. 00083 LOGICAL DOTYPE( MATMAX ) 00084 INTEGER IWORK( NMAX ), MVAL( MAXIN ), NSVAL( MAXIN ) 00085 DOUBLE PRECISION A( LDAMAX*NMAX, 2 ), B( NMAX*MAXRHS, 2 ), 00086 $ RWORK( NMAX ), WORK( NMAX*MAXRHS*2 ) 00087 REAL SWORK(NMAX*(NMAX+MAXRHS)) 00088 * .. 00089 * .. External Functions .. 00090 DOUBLE PRECISION DLAMCH, DSECND 00091 LOGICAL LSAME, LSAMEN 00092 REAL SLAMCH 00093 EXTERNAL LSAME, LSAMEN, DLAMCH, DSECND, SLAMCH 00094 * .. 00095 * .. External Subroutines .. 00096 EXTERNAL ALAREQ, DDRVAB, DDRVAC, DERRAB, DERRAC, 00097 $ ILAVER 00098 * .. 00099 * .. Scalars in Common .. 00100 LOGICAL LERR, OK 00101 CHARACTER*32 SRNAMT 00102 INTEGER INFOT, NUNIT 00103 * .. 00104 * .. Common blocks .. 00105 COMMON / INFOC / INFOT, NUNIT, OK, LERR 00106 COMMON / SRNAMC / SRNAMT 00107 * .. 00108 * .. Data statements .. 00109 DATA INTSTR / '0123456789' / 00110 * .. 00111 * .. Executable Statements .. 00112 * 00113 S1 = DSECND( ) 00114 LDA = NMAX 00115 FATAL = .FALSE. 00116 * 00117 * Read a dummy line. 00118 * 00119 READ( NIN, FMT = * ) 00120 * 00121 * Report values of parameters. 00122 * 00123 CALL ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH ) 00124 WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH 00125 * 00126 * Read the values of M 00127 * 00128 READ( NIN, FMT = * )NM 00129 IF( NM.LT.1 ) THEN 00130 WRITE( NOUT, FMT = 9996 )' NM ', NM, 1 00131 NM = 0 00132 FATAL = .TRUE. 00133 ELSE IF( NM.GT.MAXIN ) THEN 00134 WRITE( NOUT, FMT = 9995 )' NM ', NM, MAXIN 00135 NM = 0 00136 FATAL = .TRUE. 00137 END IF 00138 READ( NIN, FMT = * )( MVAL( I ), I = 1, NM ) 00139 DO 10 I = 1, NM 00140 IF( MVAL( I ).LT.0 ) THEN 00141 WRITE( NOUT, FMT = 9996 )' M ', MVAL( I ), 0 00142 FATAL = .TRUE. 00143 ELSE IF( MVAL( I ).GT.NMAX ) THEN 00144 WRITE( NOUT, FMT = 9995 )' M ', MVAL( I ), NMAX 00145 FATAL = .TRUE. 00146 END IF 00147 10 CONTINUE 00148 IF( NM.GT.0 ) 00149 $ WRITE( NOUT, FMT = 9993 )'M ', ( MVAL( I ), I = 1, NM ) 00150 * 00151 * Read the values of NRHS 00152 * 00153 READ( NIN, FMT = * )NNS 00154 IF( NNS.LT.1 ) THEN 00155 WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1 00156 NNS = 0 00157 FATAL = .TRUE. 00158 ELSE IF( NNS.GT.MAXIN ) THEN 00159 WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN 00160 NNS = 0 00161 FATAL = .TRUE. 00162 END IF 00163 READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS ) 00164 DO 30 I = 1, NNS 00165 IF( NSVAL( I ).LT.0 ) THEN 00166 WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0 00167 FATAL = .TRUE. 00168 ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN 00169 WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS 00170 FATAL = .TRUE. 00171 END IF 00172 30 CONTINUE 00173 IF( NNS.GT.0 ) 00174 $ WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS ) 00175 * 00176 * Read the threshold value for the test ratios. 00177 * 00178 READ( NIN, FMT = * )THRESH 00179 WRITE( NOUT, FMT = 9992 )THRESH 00180 * 00181 * Read the flag that indicates whether to test the driver routine. 00182 * 00183 READ( NIN, FMT = * )TSTDRV 00184 * 00185 * Read the flag that indicates whether to test the error exits. 00186 * 00187 READ( NIN, FMT = * )TSTERR 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 SEPS = SLAMCH( 'Underflow threshold' ) 00197 WRITE( NOUT, FMT = 9991 )'(single precision) underflow', SEPS 00198 SEPS = SLAMCH( 'Overflow threshold' ) 00199 WRITE( NOUT, FMT = 9991 )'(single precision) overflow ', SEPS 00200 SEPS = SLAMCH( 'Epsilon' ) 00201 WRITE( NOUT, FMT = 9991 )'(single precision) precision', SEPS 00202 WRITE( NOUT, FMT = * ) 00203 * 00204 EPS = DLAMCH( 'Underflow threshold' ) 00205 WRITE( NOUT, FMT = 9991 )'(double precision) underflow', EPS 00206 EPS = DLAMCH( 'Overflow threshold' ) 00207 WRITE( NOUT, FMT = 9991 )'(double precision) overflow ', EPS 00208 EPS = DLAMCH( 'Epsilon' ) 00209 WRITE( NOUT, FMT = 9991 )'(double precision) precision', EPS 00210 WRITE( NOUT, FMT = * ) 00211 * 00212 80 CONTINUE 00213 * 00214 * Read a test path and the number of matrix types to use. 00215 * 00216 READ( NIN, FMT = '(A72)', END = 140 )ALINE 00217 PATH = ALINE( 1: 3 ) 00218 NMATS = MATMAX 00219 I = 3 00220 90 CONTINUE 00221 I = I + 1 00222 IF( I.GT.72 ) THEN 00223 NMATS = MATMAX 00224 GO TO 130 00225 END IF 00226 IF( ALINE( I: I ).EQ.' ' ) 00227 $ GO TO 90 00228 NMATS = 0 00229 100 CONTINUE 00230 C1 = ALINE( I: I ) 00231 DO 110 K = 1, 10 00232 IF( C1.EQ.INTSTR( K: K ) ) THEN 00233 IC = K - 1 00234 GO TO 120 00235 END IF 00236 110 CONTINUE 00237 GO TO 130 00238 120 CONTINUE 00239 NMATS = NMATS*10 + IC 00240 I = I + 1 00241 IF( I.GT.72 ) 00242 $ GO TO 130 00243 GO TO 100 00244 130 CONTINUE 00245 C1 = PATH( 1: 1 ) 00246 C2 = PATH( 2: 3 ) 00247 NRHS = NSVAL( 1 ) 00248 * 00249 * Check first character for correct precision. 00250 * 00251 IF( .NOT.LSAME( C1, 'Double precision' ) ) THEN 00252 WRITE( NOUT, FMT = 9990 )PATH 00253 00254 * 00255 ELSE IF( NMATS.LE.0 ) THEN 00256 * 00257 * Check for a positive number of tests requested. 00258 * 00259 WRITE( NOUT, FMT = 9989 )PATH 00260 GO TO 140 00261 * 00262 ELSE IF( LSAMEN( 2, C2, 'GE' ) ) THEN 00263 * 00264 * GE: general matrices 00265 * 00266 NTYPES = 11 00267 CALL ALAREQ( 'DGE', NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00268 * 00269 * Test the error exits 00270 * 00271 IF( TSTERR ) 00272 $ CALL DERRAB( NOUT ) 00273 * 00274 IF( TSTDRV ) THEN 00275 CALL DDRVAB( DOTYPE, NM, MVAL, NNS, 00276 $ NSVAL, THRESH, LDA, A( 1, 1 ), 00277 $ A( 1, 2 ), B( 1, 1 ), B( 1, 2 ), 00278 $ WORK, RWORK, SWORK, IWORK, NOUT ) 00279 ELSE 00280 WRITE( NOUT, FMT = 9989 )'DSGESV' 00281 END IF 00282 * 00283 ELSE IF( LSAMEN( 2, C2, 'PO' ) ) THEN 00284 * 00285 * PO: positive definite matrices 00286 * 00287 NTYPES = 9 00288 CALL ALAREQ( 'DPO', NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00289 * 00290 * 00291 IF( TSTERR ) 00292 $ CALL DERRAC( NOUT ) 00293 * 00294 * 00295 IF( TSTDRV ) THEN 00296 CALL DDRVAC( DOTYPE, NM, MVAL, NNS, NSVAL, 00297 $ THRESH, LDA, A( 1, 1 ), A( 1, 2 ), 00298 $ B( 1, 1 ), B( 1, 2 ), 00299 $ WORK, RWORK, SWORK, NOUT ) 00300 ELSE 00301 WRITE( NOUT, FMT = 9989 )PATH 00302 END IF 00303 ELSE 00304 * 00305 END IF 00306 * 00307 * Go back to get another input line. 00308 * 00309 GO TO 80 00310 * 00311 * Branch to this line when the last record is read. 00312 * 00313 140 CONTINUE 00314 CLOSE ( NIN ) 00315 S2 = DSECND( ) 00316 WRITE( NOUT, FMT = 9998 ) 00317 WRITE( NOUT, FMT = 9997 )S2 - S1 00318 * 00319 9999 FORMAT( / ' Execution not attempted due to input errors' ) 00320 9998 FORMAT( / ' End of tests' ) 00321 9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / ) 00322 9996 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be >=', 00323 $ I6 ) 00324 9995 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be <=', 00325 $ I6 ) 00326 9994 FORMAT( ' Tests of the DOUBLE PRECISION LAPACK DSGESV/DSPOSV', 00327 $ ' routines ', 00328 $ / ' LAPACK VERSION ', I1, '.', I1, '.', I1, 00329 $ / / ' The following parameter values will be used:' ) 00330 9993 FORMAT( 4X, A4, ': ', 10I6, / 11X, 10I6 ) 00331 9992 FORMAT( / ' Routines pass computational tests if test ratio is ', 00332 $ 'less than', F8.2, / ) 00333 9991 FORMAT( ' Relative machine ', A, ' is taken to be', D16.6 ) 00334 9990 FORMAT( / 1X, A6, ' routines were not tested' ) 00335 9989 FORMAT( / 1X, A6, ' driver routines were not tested' ) 00336 9988 FORMAT( / 1X, A3, ': Unrecognized path name' ) 00337 * 00338 * End of DCHKAB 00339 * 00340 END
1.7.3 
