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