![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b DCHKAA 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 DCHKAA 00012 * 00013 * 00014 *> \par Purpose: 00015 * ============= 00016 *> 00017 *> \verbatim 00018 *> 00019 *> DCHKAA is the main test program for the DOUBLE PRECISION LAPACK 00020 *> linear equation routines 00021 *> 00022 *> The program must be driven by a short data file. The first 15 records 00023 *> (not including the first comment line) specify problem dimensions 00024 *> and program options using list-directed input. The remaining lines 00025 *> specify the LAPACK test paths and the number of matrix types to use 00026 *> in testing. An annotated example of a data file can be obtained by 00027 *> deleting the first 3 characters from the following 40 lines: 00028 *> Data file for testing DOUBLE PRECISION LAPACK linear eqn. routines 00029 *> 7 Number of values of M 00030 *> 0 1 2 3 5 10 16 Values of M (row dimension) 00031 *> 7 Number of values of N 00032 *> 0 1 2 3 5 10 16 Values of N (column dimension) 00033 *> 1 Number of values of NRHS 00034 *> 2 Values of NRHS (number of right hand sides) 00035 *> 5 Number of values of NB 00036 *> 1 3 3 3 20 Values of NB (the blocksize) 00037 *> 1 0 5 9 1 Values of NX (crossover point) 00038 *> 3 Number of values of RANK 00039 *> 30 50 90 Values of rank (as a % of N) 00040 *> 20.0 Threshold value of test ratio 00041 *> T Put T to test the LAPACK routines 00042 *> T Put T to test the driver routines 00043 *> T Put T to test the error exits 00044 *> DGE 11 List types on next line if 0 < NTYPES < 11 00045 *> DGB 8 List types on next line if 0 < NTYPES < 8 00046 *> DGT 12 List types on next line if 0 < NTYPES < 12 00047 *> DPO 9 List types on next line if 0 < NTYPES < 9 00048 *> DPS 9 List types on next line if 0 < NTYPES < 9 00049 *> DPP 9 List types on next line if 0 < NTYPES < 9 00050 *> DPB 8 List types on next line if 0 < NTYPES < 8 00051 *> DPT 12 List types on next line if 0 < NTYPES < 12 00052 *> DSY 10 List types on next line if 0 < NTYPES < 10 00053 *> DSR 10 List types on next line if 0 < NTYPES < 10 00054 *> DSP 10 List types on next line if 0 < NTYPES < 10 00055 *> DTR 18 List types on next line if 0 < NTYPES < 18 00056 *> DTP 18 List types on next line if 0 < NTYPES < 18 00057 *> DTB 17 List types on next line if 0 < NTYPES < 17 00058 *> DQR 8 List types on next line if 0 < NTYPES < 8 00059 *> DRQ 8 List types on next line if 0 < NTYPES < 8 00060 *> DLQ 8 List types on next line if 0 < NTYPES < 8 00061 *> DQL 8 List types on next line if 0 < NTYPES < 8 00062 *> DQP 6 List types on next line if 0 < NTYPES < 6 00063 *> DTZ 3 List types on next line if 0 < NTYPES < 3 00064 *> DLS 6 List types on next line if 0 < NTYPES < 6 00065 *> DEQ 00066 *> DQT 00067 *> DQX 00068 *> \endverbatim 00069 * 00070 * Parameters: 00071 * ========== 00072 * 00073 *> \verbatim 00074 *> NMAX INTEGER 00075 *> The maximum allowable value for M and N. 00076 *> 00077 *> MAXIN INTEGER 00078 *> The number of different values that can be used for each of 00079 *> M, N, NRHS, NB, NX and RANK 00080 *> 00081 *> MAXRHS INTEGER 00082 *> The maximum number of right hand sides 00083 *> 00084 *> MATMAX INTEGER 00085 *> The maximum number of matrix types to use for testing 00086 *> 00087 *> NIN INTEGER 00088 *> The unit number for input 00089 *> 00090 *> NOUT INTEGER 00091 *> The unit number for output 00092 *> \endverbatim 00093 * 00094 * Authors: 00095 * ======== 00096 * 00097 *> \author Univ. of Tennessee 00098 *> \author Univ. of California Berkeley 00099 *> \author Univ. of Colorado Denver 00100 *> \author NAG Ltd. 00101 * 00102 *> \date April 2012 00103 * 00104 *> \ingroup double_lin 00105 * 00106 * ===================================================================== 00107 PROGRAM DCHKAA 00108 * 00109 * -- LAPACK test routine (version 3.4.1) -- 00110 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00111 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00112 * April 2012 00113 * 00114 * ===================================================================== 00115 * 00116 * .. Parameters .. 00117 INTEGER NMAX 00118 PARAMETER ( NMAX = 132 ) 00119 INTEGER MAXIN 00120 PARAMETER ( MAXIN = 12 ) 00121 INTEGER MAXRHS 00122 PARAMETER ( MAXRHS = 16 ) 00123 INTEGER MATMAX 00124 PARAMETER ( MATMAX = 30 ) 00125 INTEGER NIN, NOUT 00126 PARAMETER ( NIN = 5, NOUT = 6 ) 00127 INTEGER KDMAX 00128 PARAMETER ( KDMAX = NMAX+( NMAX+1 ) / 4 ) 00129 * .. 00130 * .. Local Scalars .. 00131 LOGICAL FATAL, TSTCHK, TSTDRV, TSTERR 00132 CHARACTER C1 00133 CHARACTER*2 C2 00134 CHARACTER*3 PATH 00135 CHARACTER*10 INTSTR 00136 CHARACTER*72 ALINE 00137 INTEGER I, IC, J, K, LA, LAFAC, LDA, NB, NM, NMATS, NN, 00138 $ NNB, NNB2, NNS, NRHS, NTYPES, NRANK, 00139 $ VERS_MAJOR, VERS_MINOR, VERS_PATCH 00140 DOUBLE PRECISION EPS, S1, S2, THREQ, THRESH 00141 * .. 00142 * .. Local Arrays .. 00143 LOGICAL DOTYPE( MATMAX ) 00144 INTEGER IWORK( 25*NMAX ), MVAL( MAXIN ), 00145 $ NBVAL( MAXIN ), NBVAL2( MAXIN ), 00146 $ NSVAL( MAXIN ), NVAL( MAXIN ), NXVAL( MAXIN ), 00147 $ RANKVAL( MAXIN ), PIV( NMAX ) 00148 DOUBLE PRECISION A( ( KDMAX+1 )*NMAX, 7 ), B( NMAX*MAXRHS, 4 ), 00149 $ RWORK( 5*NMAX+2*MAXRHS ), S( 2*NMAX ), 00150 $ WORK( NMAX, NMAX+MAXRHS+30 ) 00151 * .. 00152 * .. External Functions .. 00153 LOGICAL LSAME, LSAMEN 00154 DOUBLE PRECISION DLAMCH, DSECND 00155 EXTERNAL LSAME, LSAMEN, DLAMCH, DSECND 00156 * .. 00157 * .. External Subroutines .. 00158 EXTERNAL ALAREQ, DCHKEQ, DCHKGB, DCHKGE, DCHKGT, DCHKLQ, 00159 $ DCHKPB, DCHKPO, DCHKPS, DCHKPP, DCHKPT, DCHKQ3, 00160 $ DCHKQL, DCHKQP, DCHKQR, DCHKRQ, DCHKSP, DCHKSY, 00161 $ DCHKTB, DCHKTP, DCHKTR, DCHKTZ, 00162 $ DDRVGB, DDRVGE, DDRVGT, DDRVLS, DDRVPB, DDRVPO, 00163 $ DDRVPP, DDRVPT, DDRVSP, DDRVSY, 00164 $ ILAVER, DCHKQRT, DCHKQRTP 00165 * .. 00166 * .. Scalars in Common .. 00167 LOGICAL LERR, OK 00168 CHARACTER*32 SRNAMT 00169 INTEGER INFOT, NUNIT 00170 * .. 00171 * .. Arrays in Common .. 00172 INTEGER IPARMS( 100 ) 00173 * .. 00174 * .. Common blocks .. 00175 COMMON / INFOC / INFOT, NUNIT, OK, LERR 00176 COMMON / SRNAMC / SRNAMT 00177 COMMON / CLAENV / IPARMS 00178 * .. 00179 * .. Data statements .. 00180 DATA THREQ / 2.0D0 / , INTSTR / '0123456789' / 00181 * .. 00182 * .. Executable Statements .. 00183 * 00184 S1 = DSECND( ) 00185 LDA = NMAX 00186 FATAL = .FALSE. 00187 * 00188 * Read a dummy line. 00189 * 00190 READ( NIN, FMT = * ) 00191 * 00192 * Report values of parameters. 00193 * 00194 CALL ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH ) 00195 WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH 00196 * 00197 * Read the values of M 00198 * 00199 READ( NIN, FMT = * )NM 00200 IF( NM.LT.1 ) THEN 00201 WRITE( NOUT, FMT = 9996 )' NM ', NM, 1 00202 NM = 0 00203 FATAL = .TRUE. 00204 ELSE IF( NM.GT.MAXIN ) THEN 00205 WRITE( NOUT, FMT = 9995 )' NM ', NM, MAXIN 00206 NM = 0 00207 FATAL = .TRUE. 00208 END IF 00209 READ( NIN, FMT = * )( MVAL( I ), I = 1, NM ) 00210 DO 10 I = 1, NM 00211 IF( MVAL( I ).LT.0 ) THEN 00212 WRITE( NOUT, FMT = 9996 )' M ', MVAL( I ), 0 00213 FATAL = .TRUE. 00214 ELSE IF( MVAL( I ).GT.NMAX ) THEN 00215 WRITE( NOUT, FMT = 9995 )' M ', MVAL( I ), NMAX 00216 FATAL = .TRUE. 00217 END IF 00218 10 CONTINUE 00219 IF( NM.GT.0 ) 00220 $ WRITE( NOUT, FMT = 9993 )'M ', ( MVAL( I ), I = 1, NM ) 00221 * 00222 * Read the values of N 00223 * 00224 READ( NIN, FMT = * )NN 00225 IF( NN.LT.1 ) THEN 00226 WRITE( NOUT, FMT = 9996 )' NN ', NN, 1 00227 NN = 0 00228 FATAL = .TRUE. 00229 ELSE IF( NN.GT.MAXIN ) THEN 00230 WRITE( NOUT, FMT = 9995 )' NN ', NN, MAXIN 00231 NN = 0 00232 FATAL = .TRUE. 00233 END IF 00234 READ( NIN, FMT = * )( NVAL( I ), I = 1, NN ) 00235 DO 20 I = 1, NN 00236 IF( NVAL( I ).LT.0 ) THEN 00237 WRITE( NOUT, FMT = 9996 )' N ', NVAL( I ), 0 00238 FATAL = .TRUE. 00239 ELSE IF( NVAL( I ).GT.NMAX ) THEN 00240 WRITE( NOUT, FMT = 9995 )' N ', NVAL( I ), NMAX 00241 FATAL = .TRUE. 00242 END IF 00243 20 CONTINUE 00244 IF( NN.GT.0 ) 00245 $ WRITE( NOUT, FMT = 9993 )'N ', ( NVAL( I ), I = 1, NN ) 00246 * 00247 * Read the values of NRHS 00248 * 00249 READ( NIN, FMT = * )NNS 00250 IF( NNS.LT.1 ) THEN 00251 WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1 00252 NNS = 0 00253 FATAL = .TRUE. 00254 ELSE IF( NNS.GT.MAXIN ) THEN 00255 WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN 00256 NNS = 0 00257 FATAL = .TRUE. 00258 END IF 00259 READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS ) 00260 DO 30 I = 1, NNS 00261 IF( NSVAL( I ).LT.0 ) THEN 00262 WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0 00263 FATAL = .TRUE. 00264 ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN 00265 WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS 00266 FATAL = .TRUE. 00267 END IF 00268 30 CONTINUE 00269 IF( NNS.GT.0 ) 00270 $ WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS ) 00271 * 00272 * Read the values of NB 00273 * 00274 READ( NIN, FMT = * )NNB 00275 IF( NNB.LT.1 ) THEN 00276 WRITE( NOUT, FMT = 9996 )'NNB ', NNB, 1 00277 NNB = 0 00278 FATAL = .TRUE. 00279 ELSE IF( NNB.GT.MAXIN ) THEN 00280 WRITE( NOUT, FMT = 9995 )'NNB ', NNB, MAXIN 00281 NNB = 0 00282 FATAL = .TRUE. 00283 END IF 00284 READ( NIN, FMT = * )( NBVAL( I ), I = 1, NNB ) 00285 DO 40 I = 1, NNB 00286 IF( NBVAL( I ).LT.0 ) THEN 00287 WRITE( NOUT, FMT = 9996 )' NB ', NBVAL( I ), 0 00288 FATAL = .TRUE. 00289 END IF 00290 40 CONTINUE 00291 IF( NNB.GT.0 ) 00292 $ WRITE( NOUT, FMT = 9993 )'NB ', ( NBVAL( I ), I = 1, NNB ) 00293 * 00294 * Set NBVAL2 to be the set of unique values of NB 00295 * 00296 NNB2 = 0 00297 DO 60 I = 1, NNB 00298 NB = NBVAL( I ) 00299 DO 50 J = 1, NNB2 00300 IF( NB.EQ.NBVAL2( J ) ) 00301 $ GO TO 60 00302 50 CONTINUE 00303 NNB2 = NNB2 + 1 00304 NBVAL2( NNB2 ) = NB 00305 60 CONTINUE 00306 * 00307 * Read the values of NX 00308 * 00309 READ( NIN, FMT = * )( NXVAL( I ), I = 1, NNB ) 00310 DO 70 I = 1, NNB 00311 IF( NXVAL( I ).LT.0 ) THEN 00312 WRITE( NOUT, FMT = 9996 )' NX ', NXVAL( I ), 0 00313 FATAL = .TRUE. 00314 END IF 00315 70 CONTINUE 00316 IF( NNB.GT.0 ) 00317 $ WRITE( NOUT, FMT = 9993 )'NX ', ( NXVAL( I ), I = 1, NNB ) 00318 * 00319 * Read the values of RANKVAL 00320 * 00321 READ( NIN, FMT = * )NRANK 00322 IF( NN.LT.1 ) THEN 00323 WRITE( NOUT, FMT = 9996 )' NRANK ', NRANK, 1 00324 NRANK = 0 00325 FATAL = .TRUE. 00326 ELSE IF( NN.GT.MAXIN ) THEN 00327 WRITE( NOUT, FMT = 9995 )' NRANK ', NRANK, MAXIN 00328 NRANK = 0 00329 FATAL = .TRUE. 00330 END IF 00331 READ( NIN, FMT = * )( RANKVAL( I ), I = 1, NRANK ) 00332 DO I = 1, NRANK 00333 IF( RANKVAL( I ).LT.0 ) THEN 00334 WRITE( NOUT, FMT = 9996 )' RANK ', RANKVAL( I ), 0 00335 FATAL = .TRUE. 00336 ELSE IF( RANKVAL( I ).GT.100 ) THEN 00337 WRITE( NOUT, FMT = 9995 )' RANK ', RANKVAL( I ), 100 00338 FATAL = .TRUE. 00339 END IF 00340 END DO 00341 IF( NRANK.GT.0 ) 00342 $ WRITE( NOUT, FMT = 9993 )'RANK % OF N', 00343 $ ( RANKVAL( I ), I = 1, NRANK ) 00344 * 00345 * Read the threshold value for the test ratios. 00346 * 00347 READ( NIN, FMT = * )THRESH 00348 WRITE( NOUT, FMT = 9992 )THRESH 00349 * 00350 * Read the flag that indicates whether to test the LAPACK routines. 00351 * 00352 READ( NIN, FMT = * )TSTCHK 00353 * 00354 * Read the flag that indicates whether to test the driver routines. 00355 * 00356 READ( NIN, FMT = * )TSTDRV 00357 * 00358 * Read the flag that indicates whether to test the error exits. 00359 * 00360 READ( NIN, FMT = * )TSTERR 00361 * 00362 IF( FATAL ) THEN 00363 WRITE( NOUT, FMT = 9999 ) 00364 STOP 00365 END IF 00366 * 00367 * Calculate and print the machine dependent constants. 00368 * 00369 EPS = DLAMCH( 'Underflow threshold' ) 00370 WRITE( NOUT, FMT = 9991 )'underflow', EPS 00371 EPS = DLAMCH( 'Overflow threshold' ) 00372 WRITE( NOUT, FMT = 9991 )'overflow ', EPS 00373 EPS = DLAMCH( 'Epsilon' ) 00374 WRITE( NOUT, FMT = 9991 )'precision', EPS 00375 WRITE( NOUT, FMT = * ) 00376 * 00377 80 CONTINUE 00378 * 00379 * Read a test path and the number of matrix types to use. 00380 * 00381 READ( NIN, FMT = '(A72)', END = 140 )ALINE 00382 PATH = ALINE( 1: 3 ) 00383 NMATS = MATMAX 00384 I = 3 00385 90 CONTINUE 00386 I = I + 1 00387 IF( I.GT.72 ) THEN 00388 NMATS = MATMAX 00389 GO TO 130 00390 END IF 00391 IF( ALINE( I: I ).EQ.' ' ) 00392 $ GO TO 90 00393 NMATS = 0 00394 100 CONTINUE 00395 C1 = ALINE( I: I ) 00396 DO 110 K = 1, 10 00397 IF( C1.EQ.INTSTR( K: K ) ) THEN 00398 IC = K - 1 00399 GO TO 120 00400 END IF 00401 110 CONTINUE 00402 GO TO 130 00403 120 CONTINUE 00404 NMATS = NMATS*10 + IC 00405 I = I + 1 00406 IF( I.GT.72 ) 00407 $ GO TO 130 00408 GO TO 100 00409 130 CONTINUE 00410 C1 = PATH( 1: 1 ) 00411 C2 = PATH( 2: 3 ) 00412 NRHS = NSVAL( 1 ) 00413 * 00414 * Check first character for correct precision. 00415 * 00416 IF( .NOT.LSAME( C1, 'Double precision' ) ) THEN 00417 WRITE( NOUT, FMT = 9990 )PATH 00418 * 00419 ELSE IF( NMATS.LE.0 ) THEN 00420 * 00421 * Check for a positive number of tests requested. 00422 * 00423 WRITE( NOUT, FMT = 9989 )PATH 00424 * 00425 ELSE IF( LSAMEN( 2, C2, 'GE' ) ) THEN 00426 * 00427 * GE: general matrices 00428 * 00429 NTYPES = 11 00430 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00431 * 00432 IF( TSTCHK ) THEN 00433 CALL DCHKGE( DOTYPE, NM, MVAL, NN, NVAL, NNB2, NBVAL2, NNS, 00434 $ NSVAL, THRESH, TSTERR, LDA, A( 1, 1 ), 00435 $ A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), 00436 $ B( 1, 3 ), WORK, RWORK, IWORK, NOUT ) 00437 ELSE 00438 WRITE( NOUT, FMT = 9989 )PATH 00439 END IF 00440 * 00441 IF( TSTDRV ) THEN 00442 CALL DDRVGE( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA, 00443 $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), 00444 $ B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), S, WORK, 00445 $ RWORK, IWORK, NOUT ) 00446 ELSE 00447 WRITE( NOUT, FMT = 9988 )PATH 00448 END IF 00449 * 00450 ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN 00451 * 00452 * GB: general banded matrices 00453 * 00454 LA = ( 2*KDMAX+1 )*NMAX 00455 LAFAC = ( 3*KDMAX+1 )*NMAX 00456 NTYPES = 8 00457 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00458 * 00459 IF( TSTCHK ) THEN 00460 CALL DCHKGB( DOTYPE, NM, MVAL, NN, NVAL, NNB2, NBVAL2, NNS, 00461 $ NSVAL, THRESH, TSTERR, A( 1, 1 ), LA, 00462 $ A( 1, 3 ), LAFAC, B( 1, 1 ), B( 1, 2 ), 00463 $ B( 1, 3 ), WORK, RWORK, IWORK, NOUT ) 00464 ELSE 00465 WRITE( NOUT, FMT = 9989 )PATH 00466 END IF 00467 * 00468 IF( TSTDRV ) THEN 00469 CALL DDRVGB( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, 00470 $ A( 1, 1 ), LA, A( 1, 3 ), LAFAC, A( 1, 6 ), 00471 $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), S, 00472 $ WORK, RWORK, IWORK, NOUT ) 00473 ELSE 00474 WRITE( NOUT, FMT = 9988 )PATH 00475 END IF 00476 * 00477 ELSE IF( LSAMEN( 2, C2, 'GT' ) ) THEN 00478 * 00479 * GT: general tridiagonal matrices 00480 * 00481 NTYPES = 12 00482 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00483 * 00484 IF( TSTCHK ) THEN 00485 CALL DCHKGT( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, 00486 $ A( 1, 1 ), A( 1, 2 ), B( 1, 1 ), B( 1, 2 ), 00487 $ B( 1, 3 ), WORK, RWORK, IWORK, NOUT ) 00488 ELSE 00489 WRITE( NOUT, FMT = 9989 )PATH 00490 END IF 00491 * 00492 IF( TSTDRV ) THEN 00493 CALL DDRVGT( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, 00494 $ A( 1, 1 ), A( 1, 2 ), B( 1, 1 ), B( 1, 2 ), 00495 $ B( 1, 3 ), WORK, RWORK, IWORK, NOUT ) 00496 ELSE 00497 WRITE( NOUT, FMT = 9988 )PATH 00498 END IF 00499 * 00500 ELSE IF( LSAMEN( 2, C2, 'PO' ) ) THEN 00501 * 00502 * PO: positive definite matrices 00503 * 00504 NTYPES = 9 00505 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00506 * 00507 IF( TSTCHK ) THEN 00508 CALL DCHKPO( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL, 00509 $ THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ), 00510 $ A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), 00511 $ WORK, RWORK, IWORK, NOUT ) 00512 ELSE 00513 WRITE( NOUT, FMT = 9989 )PATH 00514 END IF 00515 * 00516 IF( TSTDRV ) THEN 00517 CALL DDRVPO( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA, 00518 $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), 00519 $ B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), S, WORK, 00520 $ RWORK, IWORK, NOUT ) 00521 ELSE 00522 WRITE( NOUT, FMT = 9988 )PATH 00523 END IF 00524 * 00525 ELSE IF( LSAMEN( 2, C2, 'PS' ) ) THEN 00526 * 00527 * PS: positive semi-definite matrices 00528 * 00529 NTYPES = 9 00530 * 00531 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00532 * 00533 IF( TSTCHK ) THEN 00534 CALL DCHKPS( DOTYPE, NN, NVAL, NNB2, NBVAL2, NRANK, 00535 $ RANKVAL, THRESH, TSTERR, LDA, A( 1, 1 ), 00536 $ A( 1, 2 ), A( 1, 3 ), PIV, WORK, RWORK, 00537 $ NOUT ) 00538 ELSE 00539 WRITE( NOUT, FMT = 9989 )PATH 00540 END IF 00541 * 00542 ELSE IF( LSAMEN( 2, C2, 'PP' ) ) THEN 00543 * 00544 * PP: positive definite packed matrices 00545 * 00546 NTYPES = 9 00547 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00548 * 00549 IF( TSTCHK ) THEN 00550 CALL DCHKPP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, 00551 $ LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), 00552 $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), WORK, RWORK, 00553 $ IWORK, NOUT ) 00554 ELSE 00555 WRITE( NOUT, FMT = 9989 )PATH 00556 END IF 00557 * 00558 IF( TSTDRV ) THEN 00559 CALL DDRVPP( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA, 00560 $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), 00561 $ B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), S, WORK, 00562 $ RWORK, IWORK, NOUT ) 00563 ELSE 00564 WRITE( NOUT, FMT = 9988 )PATH 00565 END IF 00566 * 00567 ELSE IF( LSAMEN( 2, C2, 'PB' ) ) THEN 00568 * 00569 * PB: positive definite banded matrices 00570 * 00571 NTYPES = 8 00572 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00573 * 00574 IF( TSTCHK ) THEN 00575 CALL DCHKPB( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL, 00576 $ THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ), 00577 $ A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), 00578 $ WORK, RWORK, IWORK, NOUT ) 00579 ELSE 00580 WRITE( NOUT, FMT = 9989 )PATH 00581 END IF 00582 * 00583 IF( TSTDRV ) THEN 00584 CALL DDRVPB( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA, 00585 $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), 00586 $ B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), S, WORK, 00587 $ RWORK, IWORK, NOUT ) 00588 ELSE 00589 WRITE( NOUT, FMT = 9988 )PATH 00590 END IF 00591 * 00592 ELSE IF( LSAMEN( 2, C2, 'PT' ) ) THEN 00593 * 00594 * PT: positive definite tridiagonal matrices 00595 * 00596 NTYPES = 12 00597 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00598 * 00599 IF( TSTCHK ) THEN 00600 CALL DCHKPT( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, 00601 $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), 00602 $ B( 1, 2 ), B( 1, 3 ), WORK, RWORK, NOUT ) 00603 ELSE 00604 WRITE( NOUT, FMT = 9989 )PATH 00605 END IF 00606 * 00607 IF( TSTDRV ) THEN 00608 CALL DDRVPT( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, 00609 $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), 00610 $ B( 1, 2 ), B( 1, 3 ), WORK, RWORK, NOUT ) 00611 ELSE 00612 WRITE( NOUT, FMT = 9988 )PATH 00613 END IF 00614 * 00615 ELSE IF( LSAMEN( 2, C2, 'SY' ) ) THEN 00616 * 00617 * SY: symmetric indefinite matrices, 00618 * with partial (Bunch-Kaufman) pivoting algorithm 00619 * 00620 NTYPES = 10 00621 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00622 * 00623 IF( TSTCHK ) THEN 00624 CALL DCHKSY( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL, 00625 $ THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ), 00626 $ A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), 00627 $ WORK, RWORK, IWORK, NOUT ) 00628 ELSE 00629 WRITE( NOUT, FMT = 9989 )PATH 00630 END IF 00631 * 00632 IF( TSTDRV ) THEN 00633 CALL DDRVSY( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA, 00634 $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), 00635 $ B( 1, 2 ), B( 1, 3 ), WORK, RWORK, IWORK, 00636 $ NOUT ) 00637 ELSE 00638 WRITE( NOUT, FMT = 9988 )PATH 00639 END IF 00640 * 00641 ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN 00642 * 00643 * SP: symmetric indefinite packed matrices, 00644 * with partial (Bunch-Kaufman) pivoting algorithm 00645 * 00646 NTYPES = 10 00647 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00648 * 00649 IF( TSTCHK ) THEN 00650 CALL DCHKSP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, 00651 $ LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), 00652 $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), WORK, RWORK, 00653 $ IWORK, NOUT ) 00654 ELSE 00655 WRITE( NOUT, FMT = 9989 )PATH 00656 END IF 00657 * 00658 IF( TSTDRV ) THEN 00659 CALL DDRVSP( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA, 00660 $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), 00661 $ B( 1, 2 ), B( 1, 3 ), WORK, RWORK, IWORK, 00662 $ NOUT ) 00663 ELSE 00664 WRITE( NOUT, FMT = 9988 )PATH 00665 END IF 00666 * 00667 ELSE IF( LSAMEN( 2, C2, 'TR' ) ) THEN 00668 * 00669 * TR: triangular matrices 00670 * 00671 NTYPES = 18 00672 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00673 * 00674 IF( TSTCHK ) THEN 00675 CALL DCHKTR( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL, 00676 $ THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ), 00677 $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), WORK, RWORK, 00678 $ IWORK, NOUT ) 00679 ELSE 00680 WRITE( NOUT, FMT = 9989 )PATH 00681 END IF 00682 * 00683 ELSE IF( LSAMEN( 2, C2, 'TP' ) ) THEN 00684 * 00685 * TP: triangular packed matrices 00686 * 00687 NTYPES = 18 00688 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00689 * 00690 IF( TSTCHK ) THEN 00691 CALL DCHKTP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, 00692 $ LDA, A( 1, 1 ), A( 1, 2 ), B( 1, 1 ), 00693 $ B( 1, 2 ), B( 1, 3 ), WORK, RWORK, IWORK, 00694 $ NOUT ) 00695 ELSE 00696 WRITE( NOUT, FMT = 9989 )PATH 00697 END IF 00698 * 00699 ELSE IF( LSAMEN( 2, C2, 'TB' ) ) THEN 00700 * 00701 * TB: triangular banded matrices 00702 * 00703 NTYPES = 17 00704 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00705 * 00706 IF( TSTCHK ) THEN 00707 CALL DCHKTB( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, 00708 $ LDA, A( 1, 1 ), A( 1, 2 ), B( 1, 1 ), 00709 $ B( 1, 2 ), B( 1, 3 ), WORK, RWORK, IWORK, 00710 $ NOUT ) 00711 ELSE 00712 WRITE( NOUT, FMT = 9989 )PATH 00713 END IF 00714 * 00715 ELSE IF( LSAMEN( 2, C2, 'QR' ) ) THEN 00716 * 00717 * QR: QR factorization 00718 * 00719 NTYPES = 8 00720 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00721 * 00722 IF( TSTCHK ) THEN 00723 CALL DCHKQR( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, 00724 $ NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ), 00725 $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ), 00726 $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), 00727 $ WORK, RWORK, IWORK, NOUT ) 00728 ELSE 00729 WRITE( NOUT, FMT = 9989 )PATH 00730 END IF 00731 * 00732 ELSE IF( LSAMEN( 2, C2, 'LQ' ) ) THEN 00733 * 00734 * LQ: LQ factorization 00735 * 00736 NTYPES = 8 00737 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00738 * 00739 IF( TSTCHK ) THEN 00740 CALL DCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, 00741 $ NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ), 00742 $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ), 00743 $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), 00744 $ WORK, RWORK, NOUT ) 00745 ELSE 00746 WRITE( NOUT, FMT = 9989 )PATH 00747 END IF 00748 * 00749 ELSE IF( LSAMEN( 2, C2, 'QL' ) ) THEN 00750 * 00751 * QL: QL factorization 00752 * 00753 NTYPES = 8 00754 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00755 * 00756 IF( TSTCHK ) THEN 00757 CALL DCHKQL( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, 00758 $ NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ), 00759 $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ), 00760 $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), 00761 $ WORK, RWORK, IWORK, NOUT ) 00762 ELSE 00763 WRITE( NOUT, FMT = 9989 )PATH 00764 END IF 00765 * 00766 ELSE IF( LSAMEN( 2, C2, 'RQ' ) ) THEN 00767 * 00768 * RQ: RQ factorization 00769 * 00770 NTYPES = 8 00771 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00772 * 00773 IF( TSTCHK ) THEN 00774 CALL DCHKRQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, 00775 $ NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ), 00776 $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ), 00777 $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), 00778 $ WORK, RWORK, IWORK, NOUT ) 00779 ELSE 00780 WRITE( NOUT, FMT = 9989 )PATH 00781 END IF 00782 * 00783 ELSE IF( LSAMEN( 2, C2, 'QP' ) ) THEN 00784 * 00785 * QP: QR factorization with pivoting 00786 * 00787 NTYPES = 6 00788 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00789 * 00790 IF( TSTCHK ) THEN 00791 CALL DCHKQP( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, 00792 $ A( 1, 1 ), A( 1, 2 ), B( 1, 1 ), 00793 $ B( 1, 3 ), WORK, IWORK, NOUT ) 00794 CALL DCHKQ3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, 00795 $ THRESH, A( 1, 1 ), A( 1, 2 ), B( 1, 1 ), 00796 $ B( 1, 3 ), WORK, IWORK, NOUT ) 00797 ELSE 00798 WRITE( NOUT, FMT = 9989 )PATH 00799 END IF 00800 * 00801 ELSE IF( LSAMEN( 2, C2, 'TZ' ) ) THEN 00802 * 00803 * TZ: Trapezoidal matrix 00804 * 00805 NTYPES = 3 00806 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00807 * 00808 IF( TSTCHK ) THEN 00809 CALL DCHKTZ( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, 00810 $ A( 1, 1 ), A( 1, 2 ), B( 1, 1 ), 00811 $ B( 1, 3 ), WORK, NOUT ) 00812 ELSE 00813 WRITE( NOUT, FMT = 9989 )PATH 00814 END IF 00815 * 00816 ELSE IF( LSAMEN( 2, C2, 'LS' ) ) THEN 00817 * 00818 * LS: Least squares drivers 00819 * 00820 NTYPES = 6 00821 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00822 * 00823 IF( TSTDRV ) THEN 00824 CALL DDRVLS( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB, 00825 $ NBVAL, NXVAL, THRESH, TSTERR, A( 1, 1 ), 00826 $ A( 1, 2 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), 00827 $ RWORK, RWORK( NMAX+1 ), WORK, IWORK, NOUT ) 00828 ELSE 00829 WRITE( NOUT, FMT = 9988 )PATH 00830 END IF 00831 * 00832 ELSE IF( LSAMEN( 2, C2, 'EQ' ) ) THEN 00833 * 00834 * EQ: Equilibration routines for general and positive definite 00835 * matrices (THREQ should be between 2 and 10) 00836 * 00837 IF( TSTCHK ) THEN 00838 CALL DCHKEQ( THREQ, NOUT ) 00839 ELSE 00840 WRITE( NOUT, FMT = 9989 )PATH 00841 END IF 00842 * 00843 ELSE IF( LSAMEN( 2, C2, 'QT' ) ) THEN 00844 * 00845 * QT: QRT routines for general matrices 00846 * 00847 IF( TSTCHK ) THEN 00848 CALL DCHKQRT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, 00849 $ NBVAL, NOUT ) 00850 ELSE 00851 WRITE( NOUT, FMT = 9989 )PATH 00852 END IF 00853 * 00854 ELSE IF( LSAMEN( 2, C2, 'QX' ) ) THEN 00855 * 00856 * QX: QRT routines for triangular-pentagonal matrices 00857 * 00858 IF( TSTCHK ) THEN 00859 CALL DCHKQRTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, 00860 $ NBVAL, NOUT ) 00861 ELSE 00862 WRITE( NOUT, FMT = 9989 )PATH 00863 END IF 00864 * 00865 ELSE 00866 * 00867 WRITE( NOUT, FMT = 9990 )PATH 00868 END IF 00869 * 00870 * Go back to get another input line. 00871 * 00872 GO TO 80 00873 * 00874 * Branch to this line when the last record is read. 00875 * 00876 140 CONTINUE 00877 CLOSE ( NIN ) 00878 S2 = DSECND( ) 00879 WRITE( NOUT, FMT = 9998 ) 00880 WRITE( NOUT, FMT = 9997 )S2 - S1 00881 * 00882 9999 FORMAT( / ' Execution not attempted due to input errors' ) 00883 9998 FORMAT( / ' End of tests' ) 00884 9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / ) 00885 9996 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be >=', 00886 $ I6 ) 00887 9995 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be <=', 00888 $ I6 ) 00889 9994 FORMAT( ' Tests of the DOUBLE PRECISION LAPACK routines ', 00890 $ / ' LAPACK VERSION ', I1, '.', I1, '.', I1, 00891 $ / / ' The following parameter values will be used:' ) 00892 9993 FORMAT( 4X, A4, ': ', 10I6, / 11X, 10I6 ) 00893 9992 FORMAT( / ' Routines pass computational tests if test ratio is ', 00894 $ 'less than', F8.2, / ) 00895 9991 FORMAT( ' Relative machine ', A, ' is taken to be', D16.6 ) 00896 9990 FORMAT( / 1X, A3, ': Unrecognized path name' ) 00897 9989 FORMAT( / 1X, A3, ' routines were not tested' ) 00898 9988 FORMAT( / 1X, A3, ' driver routines were not tested' ) 00899 * 00900 * End of DCHKAA 00901 * 00902 END