1*> \brief \b ZDRVPO 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* SUBROUTINE ZDRVPO( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, 12* A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, 13* RWORK, NOUT ) 14* 15* .. Scalar Arguments .. 16* LOGICAL TSTERR 17* INTEGER NMAX, NN, NOUT, NRHS 18* DOUBLE PRECISION THRESH 19* .. 20* .. Array Arguments .. 21* LOGICAL DOTYPE( * ) 22* INTEGER NVAL( * ) 23* DOUBLE PRECISION RWORK( * ), S( * ) 24* COMPLEX*16 A( * ), AFAC( * ), ASAV( * ), B( * ), 25* $ BSAV( * ), WORK( * ), X( * ), XACT( * ) 26* .. 27* 28* 29*> \par Purpose: 30* ============= 31*> 32*> \verbatim 33*> 34*> ZDRVPO tests the driver routines ZPOSV and -SVX. 35*> \endverbatim 36* 37* Arguments: 38* ========== 39* 40*> \param[in] DOTYPE 41*> \verbatim 42*> DOTYPE is LOGICAL array, dimension (NTYPES) 43*> The matrix types to be used for testing. Matrices of type j 44*> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = 45*> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. 46*> \endverbatim 47*> 48*> \param[in] NN 49*> \verbatim 50*> NN is INTEGER 51*> The number of values of N contained in the vector NVAL. 52*> \endverbatim 53*> 54*> \param[in] NVAL 55*> \verbatim 56*> NVAL is INTEGER array, dimension (NN) 57*> The values of the matrix dimension N. 58*> \endverbatim 59*> 60*> \param[in] NRHS 61*> \verbatim 62*> NRHS is INTEGER 63*> The number of right hand side vectors to be generated for 64*> each linear system. 65*> \endverbatim 66*> 67*> \param[in] THRESH 68*> \verbatim 69*> THRESH is DOUBLE PRECISION 70*> The threshold value for the test ratios. A result is 71*> included in the output file if RESULT >= THRESH. To have 72*> every test ratio printed, use THRESH = 0. 73*> \endverbatim 74*> 75*> \param[in] TSTERR 76*> \verbatim 77*> TSTERR is LOGICAL 78*> Flag that indicates whether error exits are to be tested. 79*> \endverbatim 80*> 81*> \param[in] NMAX 82*> \verbatim 83*> NMAX is INTEGER 84*> The maximum value permitted for N, used in dimensioning the 85*> work arrays. 86*> \endverbatim 87*> 88*> \param[out] A 89*> \verbatim 90*> A is COMPLEX*16 array, dimension (NMAX*NMAX) 91*> \endverbatim 92*> 93*> \param[out] AFAC 94*> \verbatim 95*> AFAC is COMPLEX*16 array, dimension (NMAX*NMAX) 96*> \endverbatim 97*> 98*> \param[out] ASAV 99*> \verbatim 100*> ASAV is COMPLEX*16 array, dimension (NMAX*NMAX) 101*> \endverbatim 102*> 103*> \param[out] B 104*> \verbatim 105*> B is COMPLEX*16 array, dimension (NMAX*NRHS) 106*> \endverbatim 107*> 108*> \param[out] BSAV 109*> \verbatim 110*> BSAV is COMPLEX*16 array, dimension (NMAX*NRHS) 111*> \endverbatim 112*> 113*> \param[out] X 114*> \verbatim 115*> X is COMPLEX*16 array, dimension (NMAX*NRHS) 116*> \endverbatim 117*> 118*> \param[out] XACT 119*> \verbatim 120*> XACT is COMPLEX*16 array, dimension (NMAX*NRHS) 121*> \endverbatim 122*> 123*> \param[out] S 124*> \verbatim 125*> S is DOUBLE PRECISION array, dimension (NMAX) 126*> \endverbatim 127*> 128*> \param[out] WORK 129*> \verbatim 130*> WORK is COMPLEX*16 array, dimension 131*> (NMAX*max(3,NRHS)) 132*> \endverbatim 133*> 134*> \param[out] RWORK 135*> \verbatim 136*> RWORK is DOUBLE PRECISION array, dimension (NMAX+2*NRHS) 137*> \endverbatim 138*> 139*> \param[in] NOUT 140*> \verbatim 141*> NOUT is INTEGER 142*> The unit number for output. 143*> \endverbatim 144* 145* Authors: 146* ======== 147* 148*> \author Univ. of Tennessee 149*> \author Univ. of California Berkeley 150*> \author Univ. of Colorado Denver 151*> \author NAG Ltd. 152* 153*> \ingroup complex16_lin 154* 155* ===================================================================== 156 SUBROUTINE ZDRVPO( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, 157 $ A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, 158 $ RWORK, NOUT ) 159* 160* -- LAPACK test routine -- 161* -- LAPACK is a software package provided by Univ. of Tennessee, -- 162* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 163* 164* .. Scalar Arguments .. 165 LOGICAL TSTERR 166 INTEGER NMAX, NN, NOUT, NRHS 167 DOUBLE PRECISION THRESH 168* .. 169* .. Array Arguments .. 170 LOGICAL DOTYPE( * ) 171 INTEGER NVAL( * ) 172 DOUBLE PRECISION RWORK( * ), S( * ) 173 COMPLEX*16 A( * ), AFAC( * ), ASAV( * ), B( * ), 174 $ BSAV( * ), WORK( * ), X( * ), XACT( * ) 175* .. 176* 177* ===================================================================== 178* 179* .. Parameters .. 180 DOUBLE PRECISION ONE, ZERO 181 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) 182 INTEGER NTYPES 183 PARAMETER ( NTYPES = 9 ) 184 INTEGER NTESTS 185 PARAMETER ( NTESTS = 6 ) 186* .. 187* .. Local Scalars .. 188 LOGICAL EQUIL, NOFACT, PREFAC, ZEROT 189 CHARACTER DIST, EQUED, FACT, TYPE, UPLO, XTYPE 190 CHARACTER*3 PATH 191 INTEGER I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, IUPLO, 192 $ IZERO, K, K1, KL, KU, LDA, MODE, N, NB, NBMIN, 193 $ NERRS, NFACT, NFAIL, NIMAT, NRUN, NT 194 DOUBLE PRECISION AINVNM, AMAX, ANORM, CNDNUM, RCOND, RCONDC, 195 $ ROLDC, SCOND 196* .. 197* .. Local Arrays .. 198 CHARACTER EQUEDS( 2 ), FACTS( 3 ), UPLOS( 2 ) 199 INTEGER ISEED( 4 ), ISEEDY( 4 ) 200 DOUBLE PRECISION RESULT( NTESTS ) 201* .. 202* .. External Functions .. 203 LOGICAL LSAME 204 DOUBLE PRECISION DGET06, ZLANHE 205 EXTERNAL LSAME, DGET06, ZLANHE 206* .. 207* .. External Subroutines .. 208 EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX, ZGET04, 209 $ ZLACPY, ZLAIPD, ZLAQHE, ZLARHS, ZLASET, ZLATB4, 210 $ ZLATMS, ZPOEQU, ZPOSV, ZPOSVX, ZPOT01, ZPOT02, 211 $ ZPOT05, ZPOTRF, ZPOTRI 212* .. 213* .. Scalars in Common .. 214 LOGICAL LERR, OK 215 CHARACTER*32 SRNAMT 216 INTEGER INFOT, NUNIT 217* .. 218* .. Common blocks .. 219 COMMON / INFOC / INFOT, NUNIT, OK, LERR 220 COMMON / SRNAMC / SRNAMT 221* .. 222* .. Intrinsic Functions .. 223 INTRINSIC DCMPLX, MAX 224* .. 225* .. Data statements .. 226 DATA ISEEDY / 1988, 1989, 1990, 1991 / 227 DATA UPLOS / 'U', 'L' / 228 DATA FACTS / 'F', 'N', 'E' / 229 DATA EQUEDS / 'N', 'Y' / 230* .. 231* .. Executable Statements .. 232* 233* Initialize constants and the random number seed. 234* 235 PATH( 1: 1 ) = 'Zomplex precision' 236 PATH( 2: 3 ) = 'PO' 237 NRUN = 0 238 NFAIL = 0 239 NERRS = 0 240 DO 10 I = 1, 4 241 ISEED( I ) = ISEEDY( I ) 242 10 CONTINUE 243* 244* Test the error exits 245* 246 IF( TSTERR ) 247 $ CALL ZERRVX( PATH, NOUT ) 248 INFOT = 0 249* 250* Set the block size and minimum block size for testing. 251* 252 NB = 1 253 NBMIN = 2 254 CALL XLAENV( 1, NB ) 255 CALL XLAENV( 2, NBMIN ) 256* 257* Do for each value of N in NVAL 258* 259 DO 130 IN = 1, NN 260 N = NVAL( IN ) 261 LDA = MAX( N, 1 ) 262 XTYPE = 'N' 263 NIMAT = NTYPES 264 IF( N.LE.0 ) 265 $ NIMAT = 1 266* 267 DO 120 IMAT = 1, NIMAT 268* 269* Do the tests only if DOTYPE( IMAT ) is true. 270* 271 IF( .NOT.DOTYPE( IMAT ) ) 272 $ GO TO 120 273* 274* Skip types 3, 4, or 5 if the matrix size is too small. 275* 276 ZEROT = IMAT.GE.3 .AND. IMAT.LE.5 277 IF( ZEROT .AND. N.LT.IMAT-2 ) 278 $ GO TO 120 279* 280* Do first for UPLO = 'U', then for UPLO = 'L' 281* 282 DO 110 IUPLO = 1, 2 283 UPLO = UPLOS( IUPLO ) 284* 285* Set up parameters with ZLATB4 and generate a test matrix 286* with ZLATMS. 287* 288 CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE, 289 $ CNDNUM, DIST ) 290* 291 SRNAMT = 'ZLATMS' 292 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, 293 $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK, 294 $ INFO ) 295* 296* Check error code from ZLATMS. 297* 298 IF( INFO.NE.0 ) THEN 299 CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N, -1, 300 $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) 301 GO TO 110 302 END IF 303* 304* For types 3-5, zero one row and column of the matrix to 305* test that INFO is returned correctly. 306* 307 IF( ZEROT ) THEN 308 IF( IMAT.EQ.3 ) THEN 309 IZERO = 1 310 ELSE IF( IMAT.EQ.4 ) THEN 311 IZERO = N 312 ELSE 313 IZERO = N / 2 + 1 314 END IF 315 IOFF = ( IZERO-1 )*LDA 316* 317* Set row and column IZERO of A to 0. 318* 319 IF( IUPLO.EQ.1 ) THEN 320 DO 20 I = 1, IZERO - 1 321 A( IOFF+I ) = ZERO 322 20 CONTINUE 323 IOFF = IOFF + IZERO 324 DO 30 I = IZERO, N 325 A( IOFF ) = ZERO 326 IOFF = IOFF + LDA 327 30 CONTINUE 328 ELSE 329 IOFF = IZERO 330 DO 40 I = 1, IZERO - 1 331 A( IOFF ) = ZERO 332 IOFF = IOFF + LDA 333 40 CONTINUE 334 IOFF = IOFF - IZERO 335 DO 50 I = IZERO, N 336 A( IOFF+I ) = ZERO 337 50 CONTINUE 338 END IF 339 ELSE 340 IZERO = 0 341 END IF 342* 343* Set the imaginary part of the diagonals. 344* 345 CALL ZLAIPD( N, A, LDA+1, 0 ) 346* 347* Save a copy of the matrix A in ASAV. 348* 349 CALL ZLACPY( UPLO, N, N, A, LDA, ASAV, LDA ) 350* 351 DO 100 IEQUED = 1, 2 352 EQUED = EQUEDS( IEQUED ) 353 IF( IEQUED.EQ.1 ) THEN 354 NFACT = 3 355 ELSE 356 NFACT = 1 357 END IF 358* 359 DO 90 IFACT = 1, NFACT 360 FACT = FACTS( IFACT ) 361 PREFAC = LSAME( FACT, 'F' ) 362 NOFACT = LSAME( FACT, 'N' ) 363 EQUIL = LSAME( FACT, 'E' ) 364* 365 IF( ZEROT ) THEN 366 IF( PREFAC ) 367 $ GO TO 90 368 RCONDC = ZERO 369* 370 ELSE IF( .NOT.LSAME( FACT, 'N' ) ) THEN 371* 372* Compute the condition number for comparison with 373* the value returned by ZPOSVX (FACT = 'N' reuses 374* the condition number from the previous iteration 375* with FACT = 'F'). 376* 377 CALL ZLACPY( UPLO, N, N, ASAV, LDA, AFAC, LDA ) 378 IF( EQUIL .OR. IEQUED.GT.1 ) THEN 379* 380* Compute row and column scale factors to 381* equilibrate the matrix A. 382* 383 CALL ZPOEQU( N, AFAC, LDA, S, SCOND, AMAX, 384 $ INFO ) 385 IF( INFO.EQ.0 .AND. N.GT.0 ) THEN 386 IF( IEQUED.GT.1 ) 387 $ SCOND = ZERO 388* 389* Equilibrate the matrix. 390* 391 CALL ZLAQHE( UPLO, N, AFAC, LDA, S, SCOND, 392 $ AMAX, EQUED ) 393 END IF 394 END IF 395* 396* Save the condition number of the 397* non-equilibrated system for use in ZGET04. 398* 399 IF( EQUIL ) 400 $ ROLDC = RCONDC 401* 402* Compute the 1-norm of A. 403* 404 ANORM = ZLANHE( '1', UPLO, N, AFAC, LDA, RWORK ) 405* 406* Factor the matrix A. 407* 408 CALL ZPOTRF( UPLO, N, AFAC, LDA, INFO ) 409* 410* Form the inverse of A. 411* 412 CALL ZLACPY( UPLO, N, N, AFAC, LDA, A, LDA ) 413 CALL ZPOTRI( UPLO, N, A, LDA, INFO ) 414* 415* Compute the 1-norm condition number of A. 416* 417 AINVNM = ZLANHE( '1', UPLO, N, A, LDA, RWORK ) 418 IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN 419 RCONDC = ONE 420 ELSE 421 RCONDC = ( ONE / ANORM ) / AINVNM 422 END IF 423 END IF 424* 425* Restore the matrix A. 426* 427 CALL ZLACPY( UPLO, N, N, ASAV, LDA, A, LDA ) 428* 429* Form an exact solution and set the right hand side. 430* 431 SRNAMT = 'ZLARHS' 432 CALL ZLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU, 433 $ NRHS, A, LDA, XACT, LDA, B, LDA, 434 $ ISEED, INFO ) 435 XTYPE = 'C' 436 CALL ZLACPY( 'Full', N, NRHS, B, LDA, BSAV, LDA ) 437* 438 IF( NOFACT ) THEN 439* 440* --- Test ZPOSV --- 441* 442* Compute the L*L' or U'*U factorization of the 443* matrix and solve the system. 444* 445 CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) 446 CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) 447* 448 SRNAMT = 'ZPOSV ' 449 CALL ZPOSV( UPLO, N, NRHS, AFAC, LDA, X, LDA, 450 $ INFO ) 451* 452* Check error code from ZPOSV . 453* 454 IF( INFO.NE.IZERO ) THEN 455 CALL ALAERH( PATH, 'ZPOSV ', INFO, IZERO, 456 $ UPLO, N, N, -1, -1, NRHS, IMAT, 457 $ NFAIL, NERRS, NOUT ) 458 GO TO 70 459 ELSE IF( INFO.NE.0 ) THEN 460 GO TO 70 461 END IF 462* 463* Reconstruct matrix from factors and compute 464* residual. 465* 466 CALL ZPOT01( UPLO, N, A, LDA, AFAC, LDA, RWORK, 467 $ RESULT( 1 ) ) 468* 469* Compute residual of the computed solution. 470* 471 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, 472 $ LDA ) 473 CALL ZPOT02( UPLO, N, NRHS, A, LDA, X, LDA, 474 $ WORK, LDA, RWORK, RESULT( 2 ) ) 475* 476* Check solution from generated exact solution. 477* 478 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 479 $ RESULT( 3 ) ) 480 NT = 3 481* 482* Print information about the tests that did not 483* pass the threshold. 484* 485 DO 60 K = 1, NT 486 IF( RESULT( K ).GE.THRESH ) THEN 487 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 488 $ CALL ALADHD( NOUT, PATH ) 489 WRITE( NOUT, FMT = 9999 )'ZPOSV ', UPLO, 490 $ N, IMAT, K, RESULT( K ) 491 NFAIL = NFAIL + 1 492 END IF 493 60 CONTINUE 494 NRUN = NRUN + NT 495 70 CONTINUE 496 END IF 497* 498* --- Test ZPOSVX --- 499* 500 IF( .NOT.PREFAC ) 501 $ CALL ZLASET( UPLO, N, N, DCMPLX( ZERO ), 502 $ DCMPLX( ZERO ), AFAC, LDA ) 503 CALL ZLASET( 'Full', N, NRHS, DCMPLX( ZERO ), 504 $ DCMPLX( ZERO ), X, LDA ) 505 IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN 506* 507* Equilibrate the matrix if FACT='F' and 508* EQUED='Y'. 509* 510 CALL ZLAQHE( UPLO, N, A, LDA, S, SCOND, AMAX, 511 $ EQUED ) 512 END IF 513* 514* Solve the system and compute the condition number 515* and error bounds using ZPOSVX. 516* 517 SRNAMT = 'ZPOSVX' 518 CALL ZPOSVX( FACT, UPLO, N, NRHS, A, LDA, AFAC, 519 $ LDA, EQUED, S, B, LDA, X, LDA, RCOND, 520 $ RWORK, RWORK( NRHS+1 ), WORK, 521 $ RWORK( 2*NRHS+1 ), INFO ) 522* 523* Check the error code from ZPOSVX. 524* 525 IF( INFO.NE.IZERO ) THEN 526 CALL ALAERH( PATH, 'ZPOSVX', INFO, IZERO, 527 $ FACT // UPLO, N, N, -1, -1, NRHS, 528 $ IMAT, NFAIL, NERRS, NOUT ) 529 GO TO 90 530 END IF 531* 532 IF( INFO.EQ.0 ) THEN 533 IF( .NOT.PREFAC ) THEN 534* 535* Reconstruct matrix from factors and compute 536* residual. 537* 538 CALL ZPOT01( UPLO, N, A, LDA, AFAC, LDA, 539 $ RWORK( 2*NRHS+1 ), RESULT( 1 ) ) 540 K1 = 1 541 ELSE 542 K1 = 2 543 END IF 544* 545* Compute residual of the computed solution. 546* 547 CALL ZLACPY( 'Full', N, NRHS, BSAV, LDA, WORK, 548 $ LDA ) 549 CALL ZPOT02( UPLO, N, NRHS, ASAV, LDA, X, LDA, 550 $ WORK, LDA, RWORK( 2*NRHS+1 ), 551 $ RESULT( 2 ) ) 552* 553* Check solution from generated exact solution. 554* 555 IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED, 556 $ 'N' ) ) ) THEN 557 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, 558 $ RCONDC, RESULT( 3 ) ) 559 ELSE 560 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, 561 $ ROLDC, RESULT( 3 ) ) 562 END IF 563* 564* Check the error bounds from iterative 565* refinement. 566* 567 CALL ZPOT05( UPLO, N, NRHS, ASAV, LDA, B, LDA, 568 $ X, LDA, XACT, LDA, RWORK, 569 $ RWORK( NRHS+1 ), RESULT( 4 ) ) 570 ELSE 571 K1 = 6 572 END IF 573* 574* Compare RCOND from ZPOSVX with the computed value 575* in RCONDC. 576* 577 RESULT( 6 ) = DGET06( RCOND, RCONDC ) 578* 579* Print information about the tests that did not pass 580* the threshold. 581* 582 DO 80 K = K1, 6 583 IF( RESULT( K ).GE.THRESH ) THEN 584 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 585 $ CALL ALADHD( NOUT, PATH ) 586 IF( PREFAC ) THEN 587 WRITE( NOUT, FMT = 9997 )'ZPOSVX', FACT, 588 $ UPLO, N, EQUED, IMAT, K, RESULT( K ) 589 ELSE 590 WRITE( NOUT, FMT = 9998 )'ZPOSVX', FACT, 591 $ UPLO, N, IMAT, K, RESULT( K ) 592 END IF 593 NFAIL = NFAIL + 1 594 END IF 595 80 CONTINUE 596 NRUN = NRUN + 7 - K1 597 90 CONTINUE 598 100 CONTINUE 599 110 CONTINUE 600 120 CONTINUE 601 130 CONTINUE 602* 603* Print a summary of the results. 604* 605 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS ) 606* 607 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I1, 608 $ ', test(', I1, ')=', G12.5 ) 609 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N=', I5, 610 $ ', type ', I1, ', test(', I1, ')=', G12.5 ) 611 9997 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N=', I5, 612 $ ', EQUED=''', A1, ''', type ', I1, ', test(', I1, ') =', 613 $ G12.5 ) 614 RETURN 615* 616* End of ZDRVPO 617* 618 END 619