1*> \brief \b DCHKAA 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* PROGRAM DCHKAA 12* 13* 14*> \par Purpose: 15* ============= 16*> 17*> \verbatim 18*> 19*> DCHKAA is the main test program for the DOUBLE PRECISION LAPACK 20*> linear equation routines 21*> 22*> The program must be driven by a short data file. The first 15 records 23*> (not including the first comment line) specify problem dimensions 24*> and program options using list-directed input. The remaining lines 25*> specify the LAPACK test paths and the number of matrix types to use 26*> in testing. An annotated example of a data file can be obtained by 27*> deleting the first 3 characters from the following 40 lines: 28*> Data file for testing DOUBLE PRECISION LAPACK linear eqn. routines 29*> 7 Number of values of M 30*> 0 1 2 3 5 10 16 Values of M (row dimension) 31*> 7 Number of values of N 32*> 0 1 2 3 5 10 16 Values of N (column dimension) 33*> 1 Number of values of NRHS 34*> 2 Values of NRHS (number of right hand sides) 35*> 5 Number of values of NB 36*> 1 3 3 3 20 Values of NB (the blocksize) 37*> 1 0 5 9 1 Values of NX (crossover point) 38*> 3 Number of values of RANK 39*> 30 50 90 Values of rank (as a % of N) 40*> 20.0 Threshold value of test ratio 41*> T Put T to test the LAPACK routines 42*> T Put T to test the driver routines 43*> T Put T to test the error exits 44*> DGE 11 List types on next line if 0 < NTYPES < 11 45*> DGB 8 List types on next line if 0 < NTYPES < 8 46*> DGT 12 List types on next line if 0 < NTYPES < 12 47*> DPO 9 List types on next line if 0 < NTYPES < 9 48*> DPS 9 List types on next line if 0 < NTYPES < 9 49*> DPP 9 List types on next line if 0 < NTYPES < 9 50*> DPB 8 List types on next line if 0 < NTYPES < 8 51*> DPT 12 List types on next line if 0 < NTYPES < 12 52*> DSY 10 List types on next line if 0 < NTYPES < 10 53*> DSR 10 List types on next line if 0 < NTYPES < 10 54*> DSP 10 List types on next line if 0 < NTYPES < 10 55*> DTR 18 List types on next line if 0 < NTYPES < 18 56*> DTP 18 List types on next line if 0 < NTYPES < 18 57*> DTB 17 List types on next line if 0 < NTYPES < 17 58*> DQR 8 List types on next line if 0 < NTYPES < 8 59*> DRQ 8 List types on next line if 0 < NTYPES < 8 60*> DLQ 8 List types on next line if 0 < NTYPES < 8 61*> DQL 8 List types on next line if 0 < NTYPES < 8 62*> DQP 6 List types on next line if 0 < NTYPES < 6 63*> DTZ 3 List types on next line if 0 < NTYPES < 3 64*> DLS 6 List types on next line if 0 < NTYPES < 6 65*> DEQ 66*> DQT 67*> DQX 68*> \endverbatim 69* 70* Parameters: 71* ========== 72* 73*> \verbatim 74*> NMAX INTEGER 75*> The maximum allowable value for M and N. 76*> 77*> MAXIN INTEGER 78*> The number of different values that can be used for each of 79*> M, N, NRHS, NB, NX and RANK 80*> 81*> MAXRHS INTEGER 82*> The maximum number of right hand sides 83*> 84*> MATMAX INTEGER 85*> The maximum number of matrix types to use for testing 86*> 87*> NIN INTEGER 88*> The unit number for input 89*> 90*> NOUT INTEGER 91*> The unit number for output 92*> \endverbatim 93* 94* Authors: 95* ======== 96* 97*> \author Univ. of Tennessee 98*> \author Univ. of California Berkeley 99*> \author Univ. of Colorado Denver 100*> \author NAG Ltd. 101* 102*> \date April 2012 103* 104*> \ingroup double_lin 105* 106* ===================================================================== 107 PROGRAM DCHKAA 108* 109* -- LAPACK test routine (version 3.4.1) -- 110* -- LAPACK is a software package provided by Univ. of Tennessee, -- 111* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 112* April 2012 113* 114* ===================================================================== 115* 116* .. Parameters .. 117 INTEGER NMAX 118 PARAMETER ( NMAX = 132 ) 119 INTEGER MAXIN 120 PARAMETER ( MAXIN = 12 ) 121 INTEGER MAXRHS 122 PARAMETER ( MAXRHS = 16 ) 123 INTEGER MATMAX 124 PARAMETER ( MATMAX = 30 ) 125 INTEGER NIN, NOUT 126 PARAMETER ( NIN = 5, NOUT = 6 ) 127 INTEGER KDMAX 128 PARAMETER ( KDMAX = NMAX+( NMAX+1 ) / 4 ) 129* .. 130* .. Local Scalars .. 131 LOGICAL FATAL, TSTCHK, TSTDRV, TSTERR 132 CHARACTER C1 133 CHARACTER*2 C2 134 CHARACTER*3 PATH 135 CHARACTER*10 INTSTR 136 CHARACTER*72 ALINE 137 INTEGER I, IC, J, K, LA, LAFAC, LDA, NB, NM, NMATS, NN, 138 $ NNB, NNB2, NNS, NRHS, NTYPES, NRANK, 139 $ VERS_MAJOR, VERS_MINOR, VERS_PATCH 140 DOUBLE PRECISION EPS, S1, S2, THREQ, THRESH 141* .. 142* .. Local Arrays .. 143 LOGICAL DOTYPE( MATMAX ) 144 INTEGER IWORK( 25*NMAX ), MVAL( MAXIN ), 145 $ NBVAL( MAXIN ), NBVAL2( MAXIN ), 146 $ NSVAL( MAXIN ), NVAL( MAXIN ), NXVAL( MAXIN ), 147 $ RANKVAL( MAXIN ), PIV( NMAX ) 148 DOUBLE PRECISION A( ( KDMAX+1 )*NMAX, 7 ), B( NMAX*MAXRHS, 4 ), 149 $ RWORK( 5*NMAX+2*MAXRHS ), S( 2*NMAX ), 150 $ WORK( NMAX, NMAX+MAXRHS+30 ) 151* .. 152* .. External Functions .. 153 LOGICAL LSAME, LSAMEN 154 DOUBLE PRECISION DLAMCH, DSECND 155 EXTERNAL LSAME, LSAMEN, DLAMCH, DSECND 156* .. 157* .. External Subroutines .. 158 EXTERNAL ALAREQ, DCHKEQ, DCHKGB, DCHKGE, DCHKGT, DCHKLQ, 159 $ DCHKPB, DCHKPO, DCHKPS, DCHKPP, DCHKPT, DCHKQ3, 160 $ DCHKQL, DCHKQP, DCHKQR, DCHKRQ, DCHKSP, DCHKSY, 161 $ DCHKTB, DCHKTP, DCHKTR, DCHKTZ, 162 $ DDRVGB, DDRVGE, DDRVGT, DDRVLS, DDRVPB, DDRVPO, 163 $ DDRVPP, DDRVPT, DDRVSP, DDRVSY, 164 $ ILAVER, DCHKQRT, DCHKQRTP 165* .. 166* .. Scalars in Common .. 167 LOGICAL LERR, OK 168 CHARACTER*32 SRNAMT 169 INTEGER INFOT, NUNIT 170* .. 171* .. Arrays in Common .. 172 INTEGER IPARMS( 100 ) 173* .. 174* .. Common blocks .. 175 COMMON / INFOC / INFOT, NUNIT, OK, LERR 176 COMMON / SRNAMC / SRNAMT 177 COMMON / CLAENV / IPARMS 178* .. 179* .. Data statements .. 180 DATA THREQ / 2.0D0 / , INTSTR / '0123456789' / 181* .. 182* .. Executable Statements .. 183* 184 S1 = DSECND( ) 185 LDA = NMAX 186 FATAL = .FALSE. 187* 188* Read a dummy line. 189* 190 READ( NIN, FMT = * ) 191* 192* Report values of parameters. 193* 194 CALL ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH ) 195 WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH 196* 197* Read the values of M 198* 199 READ( NIN, FMT = * )NM 200 IF( NM.LT.1 ) THEN 201 WRITE( NOUT, FMT = 9996 )' NM ', NM, 1 202 NM = 0 203 FATAL = .TRUE. 204 ELSE IF( NM.GT.MAXIN ) THEN 205 WRITE( NOUT, FMT = 9995 )' NM ', NM, MAXIN 206 NM = 0 207 FATAL = .TRUE. 208 END IF 209 READ( NIN, FMT = * )( MVAL( I ), I = 1, NM ) 210 DO 10 I = 1, NM 211 IF( MVAL( I ).LT.0 ) THEN 212 WRITE( NOUT, FMT = 9996 )' M ', MVAL( I ), 0 213 FATAL = .TRUE. 214 ELSE IF( MVAL( I ).GT.NMAX ) THEN 215 WRITE( NOUT, FMT = 9995 )' M ', MVAL( I ), NMAX 216 FATAL = .TRUE. 217 END IF 218 10 CONTINUE 219 IF( NM.GT.0 ) 220 $ WRITE( NOUT, FMT = 9993 )'M ', ( MVAL( I ), I = 1, NM ) 221* 222* Read the values of N 223* 224 READ( NIN, FMT = * )NN 225 IF( NN.LT.1 ) THEN 226 WRITE( NOUT, FMT = 9996 )' NN ', NN, 1 227 NN = 0 228 FATAL = .TRUE. 229 ELSE IF( NN.GT.MAXIN ) THEN 230 WRITE( NOUT, FMT = 9995 )' NN ', NN, MAXIN 231 NN = 0 232 FATAL = .TRUE. 233 END IF 234 READ( NIN, FMT = * )( NVAL( I ), I = 1, NN ) 235 DO 20 I = 1, NN 236 IF( NVAL( I ).LT.0 ) THEN 237 WRITE( NOUT, FMT = 9996 )' N ', NVAL( I ), 0 238 FATAL = .TRUE. 239 ELSE IF( NVAL( I ).GT.NMAX ) THEN 240 WRITE( NOUT, FMT = 9995 )' N ', NVAL( I ), NMAX 241 FATAL = .TRUE. 242 END IF 243 20 CONTINUE 244 IF( NN.GT.0 ) 245 $ WRITE( NOUT, FMT = 9993 )'N ', ( NVAL( I ), I = 1, NN ) 246* 247* Read the values of NRHS 248* 249 READ( NIN, FMT = * )NNS 250 IF( NNS.LT.1 ) THEN 251 WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1 252 NNS = 0 253 FATAL = .TRUE. 254 ELSE IF( NNS.GT.MAXIN ) THEN 255 WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN 256 NNS = 0 257 FATAL = .TRUE. 258 END IF 259 READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS ) 260 DO 30 I = 1, NNS 261 IF( NSVAL( I ).LT.0 ) THEN 262 WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0 263 FATAL = .TRUE. 264 ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN 265 WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS 266 FATAL = .TRUE. 267 END IF 268 30 CONTINUE 269 IF( NNS.GT.0 ) 270 $ WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS ) 271* 272* Read the values of NB 273* 274 READ( NIN, FMT = * )NNB 275 IF( NNB.LT.1 ) THEN 276 WRITE( NOUT, FMT = 9996 )'NNB ', NNB, 1 277 NNB = 0 278 FATAL = .TRUE. 279 ELSE IF( NNB.GT.MAXIN ) THEN 280 WRITE( NOUT, FMT = 9995 )'NNB ', NNB, MAXIN 281 NNB = 0 282 FATAL = .TRUE. 283 END IF 284 READ( NIN, FMT = * )( NBVAL( I ), I = 1, NNB ) 285 DO 40 I = 1, NNB 286 IF( NBVAL( I ).LT.0 ) THEN 287 WRITE( NOUT, FMT = 9996 )' NB ', NBVAL( I ), 0 288 FATAL = .TRUE. 289 END IF 290 40 CONTINUE 291 IF( NNB.GT.0 ) 292 $ WRITE( NOUT, FMT = 9993 )'NB ', ( NBVAL( I ), I = 1, NNB ) 293* 294* Set NBVAL2 to be the set of unique values of NB 295* 296 NNB2 = 0 297 DO 60 I = 1, NNB 298 NB = NBVAL( I ) 299 DO 50 J = 1, NNB2 300 IF( NB.EQ.NBVAL2( J ) ) 301 $ GO TO 60 302 50 CONTINUE 303 NNB2 = NNB2 + 1 304 NBVAL2( NNB2 ) = NB 305 60 CONTINUE 306* 307* Read the values of NX 308* 309 READ( NIN, FMT = * )( NXVAL( I ), I = 1, NNB ) 310 DO 70 I = 1, NNB 311 IF( NXVAL( I ).LT.0 ) THEN 312 WRITE( NOUT, FMT = 9996 )' NX ', NXVAL( I ), 0 313 FATAL = .TRUE. 314 END IF 315 70 CONTINUE 316 IF( NNB.GT.0 ) 317 $ WRITE( NOUT, FMT = 9993 )'NX ', ( NXVAL( I ), I = 1, NNB ) 318* 319* Read the values of RANKVAL 320* 321 READ( NIN, FMT = * )NRANK 322 IF( NN.LT.1 ) THEN 323 WRITE( NOUT, FMT = 9996 )' NRANK ', NRANK, 1 324 NRANK = 0 325 FATAL = .TRUE. 326 ELSE IF( NN.GT.MAXIN ) THEN 327 WRITE( NOUT, FMT = 9995 )' NRANK ', NRANK, MAXIN 328 NRANK = 0 329 FATAL = .TRUE. 330 END IF 331 READ( NIN, FMT = * )( RANKVAL( I ), I = 1, NRANK ) 332 DO I = 1, NRANK 333 IF( RANKVAL( I ).LT.0 ) THEN 334 WRITE( NOUT, FMT = 9996 )' RANK ', RANKVAL( I ), 0 335 FATAL = .TRUE. 336 ELSE IF( RANKVAL( I ).GT.100 ) THEN 337 WRITE( NOUT, FMT = 9995 )' RANK ', RANKVAL( I ), 100 338 FATAL = .TRUE. 339 END IF 340 END DO 341 IF( NRANK.GT.0 ) 342 $ WRITE( NOUT, FMT = 9993 )'RANK % OF N', 343 $ ( RANKVAL( I ), I = 1, NRANK ) 344* 345* Read the threshold value for the test ratios. 346* 347 READ( NIN, FMT = * )THRESH 348 WRITE( NOUT, FMT = 9992 )THRESH 349* 350* Read the flag that indicates whether to test the LAPACK routines. 351* 352 READ( NIN, FMT = * )TSTCHK 353* 354* Read the flag that indicates whether to test the driver routines. 355* 356 READ( NIN, FMT = * )TSTDRV 357* 358* Read the flag that indicates whether to test the error exits. 359* 360 READ( NIN, FMT = * )TSTERR 361* 362 IF( FATAL ) THEN 363 WRITE( NOUT, FMT = 9999 ) 364 STOP 365 END IF 366* 367* Calculate and print the machine dependent constants. 368* 369 EPS = DLAMCH( 'Underflow threshold' ) 370 WRITE( NOUT, FMT = 9991 )'underflow', EPS 371 EPS = DLAMCH( 'Overflow threshold' ) 372 WRITE( NOUT, FMT = 9991 )'overflow ', EPS 373 EPS = DLAMCH( 'Epsilon' ) 374 WRITE( NOUT, FMT = 9991 )'precision', EPS 375 WRITE( NOUT, FMT = * ) 376* 377 80 CONTINUE 378* 379* Read a test path and the number of matrix types to use. 380* 381 READ( NIN, FMT = '(A72)', END = 140 )ALINE 382 PATH = ALINE( 1: 3 ) 383 NMATS = MATMAX 384 I = 3 385 90 CONTINUE 386 I = I + 1 387 IF( I.GT.72 ) THEN 388 NMATS = MATMAX 389 GO TO 130 390 END IF 391 IF( ALINE( I: I ).EQ.' ' ) 392 $ GO TO 90 393 NMATS = 0 394 100 CONTINUE 395 C1 = ALINE( I: I ) 396 DO 110 K = 1, 10 397 IF( C1.EQ.INTSTR( K: K ) ) THEN 398 IC = K - 1 399 GO TO 120 400 END IF 401 110 CONTINUE 402 GO TO 130 403 120 CONTINUE 404 NMATS = NMATS*10 + IC 405 I = I + 1 406 IF( I.GT.72 ) 407 $ GO TO 130 408 GO TO 100 409 130 CONTINUE 410 C1 = PATH( 1: 1 ) 411 C2 = PATH( 2: 3 ) 412 NRHS = NSVAL( 1 ) 413* 414* Check first character for correct precision. 415* 416 IF( .NOT.LSAME( C1, 'Double precision' ) ) THEN 417 WRITE( NOUT, FMT = 9990 )PATH 418* 419 ELSE IF( NMATS.LE.0 ) THEN 420* 421* Check for a positive number of tests requested. 422* 423 WRITE( NOUT, FMT = 9989 )PATH 424* 425 ELSE IF( LSAMEN( 2, C2, 'GE' ) ) THEN 426* 427* GE: general matrices 428* 429 NTYPES = 11 430 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 431* 432 IF( TSTCHK ) THEN 433 CALL DCHKGE( DOTYPE, NM, MVAL, NN, NVAL, NNB2, NBVAL2, NNS, 434 $ NSVAL, THRESH, TSTERR, LDA, A( 1, 1 ), 435 $ A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), 436 $ B( 1, 3 ), WORK, RWORK, IWORK, NOUT ) 437 ELSE 438 WRITE( NOUT, FMT = 9989 )PATH 439 END IF 440* 441 IF( TSTDRV ) THEN 442 CALL DDRVGE( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA, 443 $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), 444 $ B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), S, WORK, 445 $ RWORK, IWORK, NOUT ) 446 ELSE 447 WRITE( NOUT, FMT = 9988 )PATH 448 END IF 449* 450 ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN 451* 452* GB: general banded matrices 453* 454 LA = ( 2*KDMAX+1 )*NMAX 455 LAFAC = ( 3*KDMAX+1 )*NMAX 456 NTYPES = 8 457 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 458* 459 IF( TSTCHK ) THEN 460 CALL DCHKGB( DOTYPE, NM, MVAL, NN, NVAL, NNB2, NBVAL2, NNS, 461 $ NSVAL, THRESH, TSTERR, A( 1, 1 ), LA, 462 $ A( 1, 3 ), LAFAC, B( 1, 1 ), B( 1, 2 ), 463 $ B( 1, 3 ), WORK, RWORK, IWORK, NOUT ) 464 ELSE 465 WRITE( NOUT, FMT = 9989 )PATH 466 END IF 467* 468 IF( TSTDRV ) THEN 469 CALL DDRVGB( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, 470 $ A( 1, 1 ), LA, A( 1, 3 ), LAFAC, A( 1, 6 ), 471 $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), S, 472 $ WORK, RWORK, IWORK, NOUT ) 473 ELSE 474 WRITE( NOUT, FMT = 9988 )PATH 475 END IF 476* 477 ELSE IF( LSAMEN( 2, C2, 'GT' ) ) THEN 478* 479* GT: general tridiagonal matrices 480* 481 NTYPES = 12 482 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 483* 484 IF( TSTCHK ) THEN 485 CALL DCHKGT( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, 486 $ A( 1, 1 ), A( 1, 2 ), B( 1, 1 ), B( 1, 2 ), 487 $ B( 1, 3 ), WORK, RWORK, IWORK, NOUT ) 488 ELSE 489 WRITE( NOUT, FMT = 9989 )PATH 490 END IF 491* 492 IF( TSTDRV ) THEN 493 CALL DDRVGT( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, 494 $ A( 1, 1 ), A( 1, 2 ), B( 1, 1 ), B( 1, 2 ), 495 $ B( 1, 3 ), WORK, RWORK, IWORK, NOUT ) 496 ELSE 497 WRITE( NOUT, FMT = 9988 )PATH 498 END IF 499* 500 ELSE IF( LSAMEN( 2, C2, 'PO' ) ) THEN 501* 502* PO: positive definite matrices 503* 504 NTYPES = 9 505 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 506* 507 IF( TSTCHK ) THEN 508 CALL DCHKPO( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL, 509 $ THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ), 510 $ A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), 511 $ WORK, RWORK, IWORK, NOUT ) 512 ELSE 513 WRITE( NOUT, FMT = 9989 )PATH 514 END IF 515* 516 IF( TSTDRV ) THEN 517 CALL DDRVPO( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA, 518 $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), 519 $ B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), S, WORK, 520 $ RWORK, IWORK, NOUT ) 521 ELSE 522 WRITE( NOUT, FMT = 9988 )PATH 523 END IF 524* 525 ELSE IF( LSAMEN( 2, C2, 'PS' ) ) THEN 526* 527* PS: positive semi-definite matrices 528* 529 NTYPES = 9 530* 531 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 532* 533 IF( TSTCHK ) THEN 534 CALL DCHKPS( DOTYPE, NN, NVAL, NNB2, NBVAL2, NRANK, 535 $ RANKVAL, THRESH, TSTERR, LDA, A( 1, 1 ), 536 $ A( 1, 2 ), A( 1, 3 ), PIV, WORK, RWORK, 537 $ NOUT ) 538 ELSE 539 WRITE( NOUT, FMT = 9989 )PATH 540 END IF 541* 542 ELSE IF( LSAMEN( 2, C2, 'PP' ) ) THEN 543* 544* PP: positive definite packed matrices 545* 546 NTYPES = 9 547 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 548* 549 IF( TSTCHK ) THEN 550 CALL DCHKPP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, 551 $ LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), 552 $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), WORK, RWORK, 553 $ IWORK, NOUT ) 554 ELSE 555 WRITE( NOUT, FMT = 9989 )PATH 556 END IF 557* 558 IF( TSTDRV ) THEN 559 CALL DDRVPP( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA, 560 $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), 561 $ B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), S, WORK, 562 $ RWORK, IWORK, NOUT ) 563 ELSE 564 WRITE( NOUT, FMT = 9988 )PATH 565 END IF 566* 567 ELSE IF( LSAMEN( 2, C2, 'PB' ) ) THEN 568* 569* PB: positive definite banded matrices 570* 571 NTYPES = 8 572 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 573* 574 IF( TSTCHK ) THEN 575 CALL DCHKPB( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL, 576 $ THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ), 577 $ A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), 578 $ WORK, RWORK, IWORK, NOUT ) 579 ELSE 580 WRITE( NOUT, FMT = 9989 )PATH 581 END IF 582* 583 IF( TSTDRV ) THEN 584 CALL DDRVPB( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA, 585 $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), 586 $ B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), S, WORK, 587 $ RWORK, IWORK, NOUT ) 588 ELSE 589 WRITE( NOUT, FMT = 9988 )PATH 590 END IF 591* 592 ELSE IF( LSAMEN( 2, C2, 'PT' ) ) THEN 593* 594* PT: positive definite tridiagonal matrices 595* 596 NTYPES = 12 597 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 598* 599 IF( TSTCHK ) THEN 600 CALL DCHKPT( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, 601 $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), 602 $ B( 1, 2 ), B( 1, 3 ), WORK, RWORK, NOUT ) 603 ELSE 604 WRITE( NOUT, FMT = 9989 )PATH 605 END IF 606* 607 IF( TSTDRV ) THEN 608 CALL DDRVPT( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, 609 $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), 610 $ B( 1, 2 ), B( 1, 3 ), WORK, RWORK, NOUT ) 611 ELSE 612 WRITE( NOUT, FMT = 9988 )PATH 613 END IF 614* 615 ELSE IF( LSAMEN( 2, C2, 'SY' ) ) THEN 616* 617* SY: symmetric indefinite matrices, 618* with partial (Bunch-Kaufman) pivoting algorithm 619* 620 NTYPES = 10 621 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 622* 623 IF( TSTCHK ) THEN 624 CALL DCHKSY( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL, 625 $ THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ), 626 $ A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), 627 $ WORK, RWORK, IWORK, NOUT ) 628 ELSE 629 WRITE( NOUT, FMT = 9989 )PATH 630 END IF 631* 632 IF( TSTDRV ) THEN 633 CALL DDRVSY( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA, 634 $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), 635 $ B( 1, 2 ), B( 1, 3 ), WORK, RWORK, IWORK, 636 $ NOUT ) 637 ELSE 638 WRITE( NOUT, FMT = 9988 )PATH 639 END IF 640* 641 ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN 642* 643* SP: symmetric indefinite packed matrices, 644* with partial (Bunch-Kaufman) pivoting algorithm 645* 646 NTYPES = 10 647 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 648* 649 IF( TSTCHK ) THEN 650 CALL DCHKSP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, 651 $ LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), 652 $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), WORK, RWORK, 653 $ IWORK, NOUT ) 654 ELSE 655 WRITE( NOUT, FMT = 9989 )PATH 656 END IF 657* 658 IF( TSTDRV ) THEN 659 CALL DDRVSP( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA, 660 $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), 661 $ B( 1, 2 ), B( 1, 3 ), WORK, RWORK, IWORK, 662 $ NOUT ) 663 ELSE 664 WRITE( NOUT, FMT = 9988 )PATH 665 END IF 666* 667 ELSE IF( LSAMEN( 2, C2, 'TR' ) ) THEN 668* 669* TR: triangular matrices 670* 671 NTYPES = 18 672 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 673* 674 IF( TSTCHK ) THEN 675 CALL DCHKTR( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL, 676 $ THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ), 677 $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), WORK, RWORK, 678 $ IWORK, NOUT ) 679 ELSE 680 WRITE( NOUT, FMT = 9989 )PATH 681 END IF 682* 683 ELSE IF( LSAMEN( 2, C2, 'TP' ) ) THEN 684* 685* TP: triangular packed matrices 686* 687 NTYPES = 18 688 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 689* 690 IF( TSTCHK ) THEN 691 CALL DCHKTP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, 692 $ LDA, A( 1, 1 ), A( 1, 2 ), B( 1, 1 ), 693 $ B( 1, 2 ), B( 1, 3 ), WORK, RWORK, IWORK, 694 $ NOUT ) 695 ELSE 696 WRITE( NOUT, FMT = 9989 )PATH 697 END IF 698* 699 ELSE IF( LSAMEN( 2, C2, 'TB' ) ) THEN 700* 701* TB: triangular banded matrices 702* 703 NTYPES = 17 704 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 705* 706 IF( TSTCHK ) THEN 707 CALL DCHKTB( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, 708 $ LDA, A( 1, 1 ), A( 1, 2 ), B( 1, 1 ), 709 $ B( 1, 2 ), B( 1, 3 ), WORK, RWORK, IWORK, 710 $ NOUT ) 711 ELSE 712 WRITE( NOUT, FMT = 9989 )PATH 713 END IF 714* 715 ELSE IF( LSAMEN( 2, C2, 'QR' ) ) THEN 716* 717* QR: QR factorization 718* 719 NTYPES = 8 720 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 721* 722 IF( TSTCHK ) THEN 723 CALL DCHKQR( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, 724 $ NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ), 725 $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ), 726 $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), 727 $ WORK, RWORK, IWORK, NOUT ) 728 ELSE 729 WRITE( NOUT, FMT = 9989 )PATH 730 END IF 731* 732 ELSE IF( LSAMEN( 2, C2, 'LQ' ) ) THEN 733* 734* LQ: LQ factorization 735* 736 NTYPES = 8 737 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 738* 739 IF( TSTCHK ) THEN 740 CALL DCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, 741 $ NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ), 742 $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ), 743 $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), 744 $ WORK, RWORK, NOUT ) 745 ELSE 746 WRITE( NOUT, FMT = 9989 )PATH 747 END IF 748* 749 ELSE IF( LSAMEN( 2, C2, 'QL' ) ) THEN 750* 751* QL: QL factorization 752* 753 NTYPES = 8 754 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 755* 756 IF( TSTCHK ) THEN 757 CALL DCHKQL( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, 758 $ NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ), 759 $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ), 760 $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), 761 $ WORK, RWORK, IWORK, NOUT ) 762 ELSE 763 WRITE( NOUT, FMT = 9989 )PATH 764 END IF 765* 766 ELSE IF( LSAMEN( 2, C2, 'RQ' ) ) THEN 767* 768* RQ: RQ factorization 769* 770 NTYPES = 8 771 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 772* 773 IF( TSTCHK ) THEN 774 CALL DCHKRQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, 775 $ NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ), 776 $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ), 777 $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), 778 $ WORK, RWORK, IWORK, NOUT ) 779 ELSE 780 WRITE( NOUT, FMT = 9989 )PATH 781 END IF 782* 783 ELSE IF( LSAMEN( 2, C2, 'QP' ) ) THEN 784* 785* QP: QR factorization with pivoting 786* 787 NTYPES = 6 788 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 789* 790 IF( TSTCHK ) THEN 791 CALL DCHKQP( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, 792 $ A( 1, 1 ), A( 1, 2 ), B( 1, 1 ), 793 $ B( 1, 3 ), WORK, IWORK, NOUT ) 794 CALL DCHKQ3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, 795 $ THRESH, A( 1, 1 ), A( 1, 2 ), B( 1, 1 ), 796 $ B( 1, 3 ), WORK, IWORK, NOUT ) 797 ELSE 798 WRITE( NOUT, FMT = 9989 )PATH 799 END IF 800* 801 ELSE IF( LSAMEN( 2, C2, 'TZ' ) ) THEN 802* 803* TZ: Trapezoidal matrix 804* 805 NTYPES = 3 806 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 807* 808 IF( TSTCHK ) THEN 809 CALL DCHKTZ( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, 810 $ A( 1, 1 ), A( 1, 2 ), B( 1, 1 ), 811 $ B( 1, 3 ), WORK, NOUT ) 812 ELSE 813 WRITE( NOUT, FMT = 9989 )PATH 814 END IF 815* 816 ELSE IF( LSAMEN( 2, C2, 'LS' ) ) THEN 817* 818* LS: Least squares drivers 819* 820 NTYPES = 6 821 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 822* 823 IF( TSTDRV ) THEN 824 CALL DDRVLS( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB, 825 $ NBVAL, NXVAL, THRESH, TSTERR, A( 1, 1 ), 826 $ A( 1, 2 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), 827 $ RWORK, RWORK( NMAX+1 ), WORK, IWORK, NOUT ) 828 ELSE 829 WRITE( NOUT, FMT = 9988 )PATH 830 END IF 831* 832 ELSE IF( LSAMEN( 2, C2, 'EQ' ) ) THEN 833* 834* EQ: Equilibration routines for general and positive definite 835* matrices (THREQ should be between 2 and 10) 836* 837 IF( TSTCHK ) THEN 838 CALL DCHKEQ( THREQ, NOUT ) 839 ELSE 840 WRITE( NOUT, FMT = 9989 )PATH 841 END IF 842* 843 ELSE IF( LSAMEN( 2, C2, 'QT' ) ) THEN 844* 845* QT: QRT routines for general matrices 846* 847 IF( TSTCHK ) THEN 848 CALL DCHKQRT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, 849 $ NBVAL, NOUT ) 850 ELSE 851 WRITE( NOUT, FMT = 9989 )PATH 852 END IF 853* 854 ELSE IF( LSAMEN( 2, C2, 'QX' ) ) THEN 855* 856* QX: QRT routines for triangular-pentagonal matrices 857* 858 IF( TSTCHK ) THEN 859 CALL DCHKQRTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, 860 $ NBVAL, NOUT ) 861 ELSE 862 WRITE( NOUT, FMT = 9989 )PATH 863 END IF 864* 865 ELSE 866* 867 WRITE( NOUT, FMT = 9990 )PATH 868 END IF 869* 870* Go back to get another input line. 871* 872 GO TO 80 873* 874* Branch to this line when the last record is read. 875* 876 140 CONTINUE 877 CLOSE ( NIN ) 878 S2 = DSECND( ) 879 WRITE( NOUT, FMT = 9998 ) 880 WRITE( NOUT, FMT = 9997 )S2 - S1 881* 882 9999 FORMAT( / ' Execution not attempted due to input errors' ) 883 9998 FORMAT( / ' End of tests' ) 884 9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / ) 885 9996 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be >=', 886 $ I6 ) 887 9995 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be <=', 888 $ I6 ) 889 9994 FORMAT( ' Tests of the DOUBLE PRECISION LAPACK routines ', 890 $ / ' LAPACK VERSION ', I1, '.', I1, '.', I1, 891 $ / / ' The following parameter values will be used:' ) 892 9993 FORMAT( 4X, A4, ': ', 10I6, / 11X, 10I6 ) 893 9992 FORMAT( / ' Routines pass computational tests if test ratio is ', 894 $ 'less than', F8.2, / ) 895 9991 FORMAT( ' Relative machine ', A, ' is taken to be', D16.6 ) 896 9990 FORMAT( / 1X, A3, ': Unrecognized path name' ) 897 9989 FORMAT( / 1X, A3, ' routines were not tested' ) 898 9988 FORMAT( / 1X, A3, ' driver routines were not tested' ) 899* 900* End of DCHKAA 901* 902 END 903