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