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