1*> \brief \b ZDRVGEX 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 ZDRVGE( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, 12* A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, 13* RWORK, IWORK, 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 IWORK( * ), 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*> ZDRVGE tests the driver routines ZGESV, -SVX, and -SVXX. 35*> 36*> Note that this file is used only when the XBLAS are available, 37*> otherwise zdrvge.f defines this subroutine. 38*> \endverbatim 39* 40* Arguments: 41* ========== 42* 43*> \param[in] DOTYPE 44*> \verbatim 45*> DOTYPE is LOGICAL array, dimension (NTYPES) 46*> The matrix types to be used for testing. Matrices of type j 47*> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = 48*> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. 49*> \endverbatim 50*> 51*> \param[in] NN 52*> \verbatim 53*> NN is INTEGER 54*> The number of values of N contained in the vector NVAL. 55*> \endverbatim 56*> 57*> \param[in] NVAL 58*> \verbatim 59*> NVAL is INTEGER array, dimension (NN) 60*> The values of the matrix column dimension N. 61*> \endverbatim 62*> 63*> \param[in] NRHS 64*> \verbatim 65*> NRHS is INTEGER 66*> The number of right hand side vectors to be generated for 67*> each linear system. 68*> \endverbatim 69*> 70*> \param[in] THRESH 71*> \verbatim 72*> THRESH is DOUBLE PRECISION 73*> The threshold value for the test ratios. A result is 74*> included in the output file if RESULT >= THRESH. To have 75*> every test ratio printed, use THRESH = 0. 76*> \endverbatim 77*> 78*> \param[in] TSTERR 79*> \verbatim 80*> TSTERR is LOGICAL 81*> Flag that indicates whether error exits are to be tested. 82*> \endverbatim 83*> 84*> \param[in] NMAX 85*> \verbatim 86*> NMAX is INTEGER 87*> The maximum value permitted for N, used in dimensioning the 88*> work arrays. 89*> \endverbatim 90*> 91*> \param[out] A 92*> \verbatim 93*> A is COMPLEX*16 array, dimension (NMAX*NMAX) 94*> \endverbatim 95*> 96*> \param[out] AFAC 97*> \verbatim 98*> AFAC is COMPLEX*16 array, dimension (NMAX*NMAX) 99*> \endverbatim 100*> 101*> \param[out] ASAV 102*> \verbatim 103*> ASAV is COMPLEX*16 array, dimension (NMAX*NMAX) 104*> \endverbatim 105*> 106*> \param[out] B 107*> \verbatim 108*> B is COMPLEX*16 array, dimension (NMAX*NRHS) 109*> \endverbatim 110*> 111*> \param[out] BSAV 112*> \verbatim 113*> BSAV is COMPLEX*16 array, dimension (NMAX*NRHS) 114*> \endverbatim 115*> 116*> \param[out] X 117*> \verbatim 118*> X is COMPLEX*16 array, dimension (NMAX*NRHS) 119*> \endverbatim 120*> 121*> \param[out] XACT 122*> \verbatim 123*> XACT is COMPLEX*16 array, dimension (NMAX*NRHS) 124*> \endverbatim 125*> 126*> \param[out] S 127*> \verbatim 128*> S is DOUBLE PRECISION array, dimension (2*NMAX) 129*> \endverbatim 130*> 131*> \param[out] WORK 132*> \verbatim 133*> WORK is COMPLEX*16 array, dimension 134*> (NMAX*max(3,NRHS)) 135*> \endverbatim 136*> 137*> \param[out] RWORK 138*> \verbatim 139*> RWORK is DOUBLE PRECISION array, dimension (2*NRHS+NMAX) 140*> \endverbatim 141*> 142*> \param[out] IWORK 143*> \verbatim 144*> IWORK is INTEGER array, dimension (NMAX) 145*> \endverbatim 146*> 147*> \param[in] NOUT 148*> \verbatim 149*> NOUT is INTEGER 150*> The unit number for output. 151*> \endverbatim 152* 153* Authors: 154* ======== 155* 156*> \author Univ. of Tennessee 157*> \author Univ. of California Berkeley 158*> \author Univ. of Colorado Denver 159*> \author NAG Ltd. 160* 161*> \date April 2012 162* 163*> \ingroup complex16_lin 164* 165* ===================================================================== 166 SUBROUTINE ZDRVGE( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, 167 $ A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, 168 $ RWORK, IWORK, NOUT ) 169* 170* -- LAPACK test routine (version 3.4.1) -- 171* -- LAPACK is a software package provided by Univ. of Tennessee, -- 172* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 173* April 2012 174* 175* .. Scalar Arguments .. 176 LOGICAL TSTERR 177 INTEGER NMAX, NN, NOUT, NRHS 178 DOUBLE PRECISION THRESH 179* .. 180* .. Array Arguments .. 181 LOGICAL DOTYPE( * ) 182 INTEGER IWORK( * ), NVAL( * ) 183 DOUBLE PRECISION RWORK( * ), S( * ) 184 COMPLEX*16 A( * ), AFAC( * ), ASAV( * ), B( * ), 185 $ BSAV( * ), WORK( * ), X( * ), XACT( * ) 186* .. 187* 188* ===================================================================== 189* 190* .. Parameters .. 191 DOUBLE PRECISION ONE, ZERO 192 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) 193 INTEGER NTYPES 194 PARAMETER ( NTYPES = 11 ) 195 INTEGER NTESTS 196 PARAMETER ( NTESTS = 7 ) 197 INTEGER NTRAN 198 PARAMETER ( NTRAN = 3 ) 199* .. 200* .. Local Scalars .. 201 LOGICAL EQUIL, NOFACT, PREFAC, TRFCON, ZEROT 202 CHARACTER DIST, EQUED, FACT, TRANS, TYPE, XTYPE 203 CHARACTER*3 PATH 204 INTEGER I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, ITRAN, 205 $ IZERO, K, K1, KL, KU, LDA, LWORK, MODE, N, NB, 206 $ NBMIN, NERRS, NFACT, NFAIL, NIMAT, NRUN, NT, 207 $ N_ERR_BNDS 208 DOUBLE PRECISION AINVNM, AMAX, ANORM, ANORMI, ANORMO, CNDNUM, 209 $ COLCND, RCOND, RCONDC, RCONDI, RCONDO, ROLDC, 210 $ ROLDI, ROLDO, ROWCND, RPVGRW, RPVGRW_SVXX 211* .. 212* .. Local Arrays .. 213 CHARACTER EQUEDS( 4 ), FACTS( 3 ), TRANSS( NTRAN ) 214 INTEGER ISEED( 4 ), ISEEDY( 4 ) 215 DOUBLE PRECISION RDUM( 1 ), RESULT( NTESTS ), BERR( NRHS ), 216 $ ERRBNDS_N( NRHS, 3 ), ERRBNDS_C( NRHS, 3 ) 217* .. 218* .. External Functions .. 219 LOGICAL LSAME 220 DOUBLE PRECISION DGET06, DLAMCH, ZLANGE, ZLANTR, ZLA_GERPVGRW 221 EXTERNAL LSAME, DGET06, DLAMCH, ZLANGE, ZLANTR, 222 $ ZLA_GERPVGRW 223* .. 224* .. External Subroutines .. 225 EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX, ZGEEQU, 226 $ ZGESV, ZGESVX, ZGET01, ZGET02, ZGET04, ZGET07, 227 $ ZGETRF, ZGETRI, ZLACPY, ZLAQGE, ZLARHS, ZLASET, 228 $ ZLATB4, ZLATMS, ZGESVXX 229* .. 230* .. Intrinsic Functions .. 231 INTRINSIC ABS, DCMPLX, MAX, DBLE, DIMAG 232* .. 233* .. Scalars in Common .. 234 LOGICAL LERR, OK 235 CHARACTER*32 SRNAMT 236 INTEGER INFOT, NUNIT 237* .. 238* .. Common blocks .. 239 COMMON / INFOC / INFOT, NUNIT, OK, LERR 240 COMMON / SRNAMC / SRNAMT 241* .. 242* .. Data statements .. 243 DATA ISEEDY / 1988, 1989, 1990, 1991 / 244 DATA TRANSS / 'N', 'T', 'C' / 245 DATA FACTS / 'F', 'N', 'E' / 246 DATA EQUEDS / 'N', 'R', 'C', 'B' / 247* .. 248* .. Executable Statements .. 249* 250* Initialize constants and the random number seed. 251* 252 PATH( 1: 1 ) = 'Zomplex precision' 253 PATH( 2: 3 ) = 'GE' 254 NRUN = 0 255 NFAIL = 0 256 NERRS = 0 257 DO 10 I = 1, 4 258 ISEED( I ) = ISEEDY( I ) 259 10 CONTINUE 260* 261* Test the error exits 262* 263 IF( TSTERR ) 264 $ CALL ZERRVX( PATH, NOUT ) 265 INFOT = 0 266* 267* Set the block size and minimum block size for testing. 268* 269 NB = 1 270 NBMIN = 2 271 CALL XLAENV( 1, NB ) 272 CALL XLAENV( 2, NBMIN ) 273* 274* Do for each value of N in NVAL 275* 276 DO 90 IN = 1, NN 277 N = NVAL( IN ) 278 LDA = MAX( N, 1 ) 279 XTYPE = 'N' 280 NIMAT = NTYPES 281 IF( N.LE.0 ) 282 $ NIMAT = 1 283* 284 DO 80 IMAT = 1, NIMAT 285* 286* Do the tests only if DOTYPE( IMAT ) is true. 287* 288 IF( .NOT.DOTYPE( IMAT ) ) 289 $ GO TO 80 290* 291* Skip types 5, 6, or 7 if the matrix size is too small. 292* 293 ZEROT = IMAT.GE.5 .AND. IMAT.LE.7 294 IF( ZEROT .AND. N.LT.IMAT-4 ) 295 $ GO TO 80 296* 297* Set up parameters with ZLATB4 and generate a test matrix 298* with ZLATMS. 299* 300 CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE, 301 $ CNDNUM, DIST ) 302 RCONDC = ONE / CNDNUM 303* 304 SRNAMT = 'ZLATMS' 305 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, CNDNUM, 306 $ ANORM, KL, KU, 'No packing', A, LDA, WORK, 307 $ INFO ) 308* 309* Check error code from ZLATMS. 310* 311 IF( INFO.NE.0 ) THEN 312 CALL ALAERH( PATH, 'ZLATMS', INFO, 0, ' ', N, N, -1, -1, 313 $ -1, IMAT, NFAIL, NERRS, NOUT ) 314 GO TO 80 315 END IF 316* 317* For types 5-7, zero one or more columns of the matrix to 318* test that INFO is returned correctly. 319* 320 IF( ZEROT ) THEN 321 IF( IMAT.EQ.5 ) THEN 322 IZERO = 1 323 ELSE IF( IMAT.EQ.6 ) THEN 324 IZERO = N 325 ELSE 326 IZERO = N / 2 + 1 327 END IF 328 IOFF = ( IZERO-1 )*LDA 329 IF( IMAT.LT.7 ) THEN 330 DO 20 I = 1, N 331 A( IOFF+I ) = ZERO 332 20 CONTINUE 333 ELSE 334 CALL ZLASET( 'Full', N, N-IZERO+1, DCMPLX( ZERO ), 335 $ DCMPLX( ZERO ), A( IOFF+1 ), LDA ) 336 END IF 337 ELSE 338 IZERO = 0 339 END IF 340* 341* Save a copy of the matrix A in ASAV. 342* 343 CALL ZLACPY( 'Full', N, N, A, LDA, ASAV, LDA ) 344* 345 DO 70 IEQUED = 1, 4 346 EQUED = EQUEDS( IEQUED ) 347 IF( IEQUED.EQ.1 ) THEN 348 NFACT = 3 349 ELSE 350 NFACT = 1 351 END IF 352* 353 DO 60 IFACT = 1, NFACT 354 FACT = FACTS( IFACT ) 355 PREFAC = LSAME( FACT, 'F' ) 356 NOFACT = LSAME( FACT, 'N' ) 357 EQUIL = LSAME( FACT, 'E' ) 358* 359 IF( ZEROT ) THEN 360 IF( PREFAC ) 361 $ GO TO 60 362 RCONDO = ZERO 363 RCONDI = ZERO 364* 365 ELSE IF( .NOT.NOFACT ) THEN 366* 367* Compute the condition number for comparison with 368* the value returned by ZGESVX (FACT = 'N' reuses 369* the condition number from the previous iteration 370* with FACT = 'F'). 371* 372 CALL ZLACPY( 'Full', N, N, ASAV, LDA, AFAC, LDA ) 373 IF( EQUIL .OR. IEQUED.GT.1 ) THEN 374* 375* Compute row and column scale factors to 376* equilibrate the matrix A. 377* 378 CALL ZGEEQU( N, N, AFAC, LDA, S, S( N+1 ), 379 $ ROWCND, COLCND, AMAX, INFO ) 380 IF( INFO.EQ.0 .AND. N.GT.0 ) THEN 381 IF( LSAME( EQUED, 'R' ) ) THEN 382 ROWCND = ZERO 383 COLCND = ONE 384 ELSE IF( LSAME( EQUED, 'C' ) ) THEN 385 ROWCND = ONE 386 COLCND = ZERO 387 ELSE IF( LSAME( EQUED, 'B' ) ) THEN 388 ROWCND = ZERO 389 COLCND = ZERO 390 END IF 391* 392* Equilibrate the matrix. 393* 394 CALL ZLAQGE( N, N, AFAC, LDA, S, S( N+1 ), 395 $ ROWCND, COLCND, AMAX, EQUED ) 396 END IF 397 END IF 398* 399* Save the condition number of the non-equilibrated 400* system for use in ZGET04. 401* 402 IF( EQUIL ) THEN 403 ROLDO = RCONDO 404 ROLDI = RCONDI 405 END IF 406* 407* Compute the 1-norm and infinity-norm of A. 408* 409 ANORMO = ZLANGE( '1', N, N, AFAC, LDA, RWORK ) 410 ANORMI = ZLANGE( 'I', N, N, AFAC, LDA, RWORK ) 411* 412* Factor the matrix A. 413* 414 CALL ZGETRF( N, N, AFAC, LDA, IWORK, INFO ) 415* 416* Form the inverse of A. 417* 418 CALL ZLACPY( 'Full', N, N, AFAC, LDA, A, LDA ) 419 LWORK = NMAX*MAX( 3, NRHS ) 420 CALL ZGETRI( N, A, LDA, IWORK, WORK, LWORK, INFO ) 421* 422* Compute the 1-norm condition number of A. 423* 424 AINVNM = ZLANGE( '1', N, N, A, LDA, RWORK ) 425 IF( ANORMO.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN 426 RCONDO = ONE 427 ELSE 428 RCONDO = ( ONE / ANORMO ) / AINVNM 429 END IF 430* 431* Compute the infinity-norm condition number of A. 432* 433 AINVNM = ZLANGE( 'I', N, N, A, LDA, RWORK ) 434 IF( ANORMI.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN 435 RCONDI = ONE 436 ELSE 437 RCONDI = ( ONE / ANORMI ) / AINVNM 438 END IF 439 END IF 440* 441 DO 50 ITRAN = 1, NTRAN 442* 443* Do for each value of TRANS. 444* 445 TRANS = TRANSS( ITRAN ) 446 IF( ITRAN.EQ.1 ) THEN 447 RCONDC = RCONDO 448 ELSE 449 RCONDC = RCONDI 450 END IF 451* 452* Restore the matrix A. 453* 454 CALL ZLACPY( 'Full', N, N, ASAV, LDA, A, LDA ) 455* 456* Form an exact solution and set the right hand side. 457* 458 SRNAMT = 'ZLARHS' 459 CALL ZLARHS( PATH, XTYPE, 'Full', TRANS, N, N, KL, 460 $ KU, NRHS, A, LDA, XACT, LDA, B, LDA, 461 $ ISEED, INFO ) 462 XTYPE = 'C' 463 CALL ZLACPY( 'Full', N, NRHS, B, LDA, BSAV, LDA ) 464* 465 IF( NOFACT .AND. ITRAN.EQ.1 ) THEN 466* 467* --- Test ZGESV --- 468* 469* Compute the LU factorization of the matrix and 470* solve the system. 471* 472 CALL ZLACPY( 'Full', N, N, A, LDA, AFAC, LDA ) 473 CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) 474* 475 SRNAMT = 'ZGESV ' 476 CALL ZGESV( N, NRHS, AFAC, LDA, IWORK, X, LDA, 477 $ INFO ) 478* 479* Check error code from ZGESV . 480* 481 IF( INFO.NE.IZERO ) 482 $ CALL ALAERH( PATH, 'ZGESV ', INFO, IZERO, 483 $ ' ', N, N, -1, -1, NRHS, IMAT, 484 $ NFAIL, NERRS, NOUT ) 485* 486* Reconstruct matrix from factors and compute 487* residual. 488* 489 CALL ZGET01( N, N, A, LDA, AFAC, LDA, IWORK, 490 $ RWORK, RESULT( 1 ) ) 491 NT = 1 492 IF( IZERO.EQ.0 ) THEN 493* 494* Compute residual of the computed solution. 495* 496 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, 497 $ LDA ) 498 CALL ZGET02( 'No transpose', N, N, NRHS, A, 499 $ LDA, X, LDA, WORK, LDA, RWORK, 500 $ RESULT( 2 ) ) 501* 502* Check solution from generated exact solution. 503* 504 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, 505 $ RCONDC, RESULT( 3 ) ) 506 NT = 3 507 END IF 508* 509* Print information about the tests that did not 510* pass the threshold. 511* 512 DO 30 K = 1, NT 513 IF( RESULT( K ).GE.THRESH ) THEN 514 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 515 $ CALL ALADHD( NOUT, PATH ) 516 WRITE( NOUT, FMT = 9999 )'ZGESV ', N, 517 $ IMAT, K, RESULT( K ) 518 NFAIL = NFAIL + 1 519 END IF 520 30 CONTINUE 521 NRUN = NRUN + NT 522 END IF 523* 524* --- Test ZGESVX --- 525* 526 IF( .NOT.PREFAC ) 527 $ CALL ZLASET( 'Full', N, N, DCMPLX( ZERO ), 528 $ DCMPLX( ZERO ), AFAC, LDA ) 529 CALL ZLASET( 'Full', N, NRHS, DCMPLX( ZERO ), 530 $ DCMPLX( ZERO ), X, LDA ) 531 IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN 532* 533* Equilibrate the matrix if FACT = 'F' and 534* EQUED = 'R', 'C', or 'B'. 535* 536 CALL ZLAQGE( N, N, A, LDA, S, S( N+1 ), ROWCND, 537 $ COLCND, AMAX, EQUED ) 538 END IF 539* 540* Solve the system and compute the condition number 541* and error bounds using ZGESVX. 542* 543 SRNAMT = 'ZGESVX' 544 CALL ZGESVX( FACT, TRANS, N, NRHS, A, LDA, AFAC, 545 $ LDA, IWORK, EQUED, S, S( N+1 ), B, 546 $ LDA, X, LDA, RCOND, RWORK, 547 $ RWORK( NRHS+1 ), WORK, 548 $ RWORK( 2*NRHS+1 ), INFO ) 549* 550* Check the error code from ZGESVX. 551* 552 IF( INFO.NE.IZERO ) 553 $ CALL ALAERH( PATH, 'ZGESVX', INFO, IZERO, 554 $ FACT // TRANS, N, N, -1, -1, NRHS, 555 $ IMAT, NFAIL, NERRS, NOUT ) 556* 557* Compare RWORK(2*NRHS+1) from ZGESVX with the 558* computed reciprocal pivot growth factor RPVGRW 559* 560 IF( INFO.NE.0 ) THEN 561 RPVGRW = ZLANTR( 'M', 'U', 'N', INFO, INFO, 562 $ AFAC, LDA, RDUM ) 563 IF( RPVGRW.EQ.ZERO ) THEN 564 RPVGRW = ONE 565 ELSE 566 RPVGRW = ZLANGE( 'M', N, INFO, A, LDA, 567 $ RDUM ) / RPVGRW 568 END IF 569 ELSE 570 RPVGRW = ZLANTR( 'M', 'U', 'N', N, N, AFAC, LDA, 571 $ RDUM ) 572 IF( RPVGRW.EQ.ZERO ) THEN 573 RPVGRW = ONE 574 ELSE 575 RPVGRW = ZLANGE( 'M', N, N, A, LDA, RDUM ) / 576 $ RPVGRW 577 END IF 578 END IF 579 RESULT( 7 ) = ABS( RPVGRW-RWORK( 2*NRHS+1 ) ) / 580 $ MAX( RWORK( 2*NRHS+1 ), RPVGRW ) / 581 $ DLAMCH( 'E' ) 582* 583 IF( .NOT.PREFAC ) THEN 584* 585* Reconstruct matrix from factors and compute 586* residual. 587* 588 CALL ZGET01( N, N, A, LDA, AFAC, LDA, IWORK, 589 $ RWORK( 2*NRHS+1 ), RESULT( 1 ) ) 590 K1 = 1 591 ELSE 592 K1 = 2 593 END IF 594* 595 IF( INFO.EQ.0 ) THEN 596 TRFCON = .FALSE. 597* 598* Compute residual of the computed solution. 599* 600 CALL ZLACPY( 'Full', N, NRHS, BSAV, LDA, WORK, 601 $ LDA ) 602 CALL ZGET02( TRANS, N, N, NRHS, ASAV, LDA, X, 603 $ LDA, WORK, LDA, RWORK( 2*NRHS+1 ), 604 $ RESULT( 2 ) ) 605* 606* Check solution from generated exact solution. 607* 608 IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED, 609 $ 'N' ) ) ) THEN 610 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, 611 $ RCONDC, RESULT( 3 ) ) 612 ELSE 613 IF( ITRAN.EQ.1 ) THEN 614 ROLDC = ROLDO 615 ELSE 616 ROLDC = ROLDI 617 END IF 618 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, 619 $ ROLDC, RESULT( 3 ) ) 620 END IF 621* 622* Check the error bounds from iterative 623* refinement. 624* 625 CALL ZGET07( TRANS, N, NRHS, ASAV, LDA, B, LDA, 626 $ X, LDA, XACT, LDA, RWORK, .TRUE., 627 $ RWORK( NRHS+1 ), RESULT( 4 ) ) 628 ELSE 629 TRFCON = .TRUE. 630 END IF 631* 632* Compare RCOND from ZGESVX with the computed value 633* in RCONDC. 634* 635 RESULT( 6 ) = DGET06( RCOND, RCONDC ) 636* 637* Print information about the tests that did not pass 638* the threshold. 639* 640 IF( .NOT.TRFCON ) THEN 641 DO 40 K = K1, NTESTS 642 IF( RESULT( K ).GE.THRESH ) THEN 643 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 644 $ CALL ALADHD( NOUT, PATH ) 645 IF( PREFAC ) THEN 646 WRITE( NOUT, FMT = 9997 )'ZGESVX', 647 $ FACT, TRANS, N, EQUED, IMAT, K, 648 $ RESULT( K ) 649 ELSE 650 WRITE( NOUT, FMT = 9998 )'ZGESVX', 651 $ FACT, TRANS, N, IMAT, K, RESULT( K ) 652 END IF 653 NFAIL = NFAIL + 1 654 END IF 655 40 CONTINUE 656 NRUN = NRUN + 7 - K1 657 ELSE 658 IF( RESULT( 1 ).GE.THRESH .AND. .NOT.PREFAC ) 659 $ THEN 660 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 661 $ CALL ALADHD( NOUT, PATH ) 662 IF( PREFAC ) THEN 663 WRITE( NOUT, FMT = 9997 )'ZGESVX', FACT, 664 $ TRANS, N, EQUED, IMAT, 1, RESULT( 1 ) 665 ELSE 666 WRITE( NOUT, FMT = 9998 )'ZGESVX', FACT, 667 $ TRANS, N, IMAT, 1, RESULT( 1 ) 668 END IF 669 NFAIL = NFAIL + 1 670 NRUN = NRUN + 1 671 END IF 672 IF( RESULT( 6 ).GE.THRESH ) THEN 673 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 674 $ CALL ALADHD( NOUT, PATH ) 675 IF( PREFAC ) THEN 676 WRITE( NOUT, FMT = 9997 )'ZGESVX', FACT, 677 $ TRANS, N, EQUED, IMAT, 6, RESULT( 6 ) 678 ELSE 679 WRITE( NOUT, FMT = 9998 )'ZGESVX', FACT, 680 $ TRANS, N, IMAT, 6, RESULT( 6 ) 681 END IF 682 NFAIL = NFAIL + 1 683 NRUN = NRUN + 1 684 END IF 685 IF( RESULT( 7 ).GE.THRESH ) THEN 686 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 687 $ CALL ALADHD( NOUT, PATH ) 688 IF( PREFAC ) THEN 689 WRITE( NOUT, FMT = 9997 )'ZGESVX', FACT, 690 $ TRANS, N, EQUED, IMAT, 7, RESULT( 7 ) 691 ELSE 692 WRITE( NOUT, FMT = 9998 )'ZGESVX', FACT, 693 $ TRANS, N, IMAT, 7, RESULT( 7 ) 694 END IF 695 NFAIL = NFAIL + 1 696 NRUN = NRUN + 1 697 END IF 698* 699 END IF 700* 701* --- Test ZGESVXX --- 702* 703* Restore the matrices A and B. 704* 705 706 CALL ZLACPY( 'Full', N, N, ASAV, LDA, A, LDA ) 707 CALL ZLACPY( 'Full', N, NRHS, BSAV, LDA, B, LDA ) 708 709 IF( .NOT.PREFAC ) 710 $ CALL ZLASET( 'Full', N, N, ZERO, ZERO, AFAC, 711 $ LDA ) 712 CALL ZLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDA ) 713 IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN 714* 715* Equilibrate the matrix if FACT = 'F' and 716* EQUED = 'R', 'C', or 'B'. 717* 718 CALL ZLAQGE( N, N, A, LDA, S, S( N+1 ), ROWCND, 719 $ COLCND, AMAX, EQUED ) 720 END IF 721* 722* Solve the system and compute the condition number 723* and error bounds using ZGESVXX. 724* 725 SRNAMT = 'ZGESVXX' 726 N_ERR_BNDS = 3 727 CALL ZGESVXX( FACT, TRANS, N, NRHS, A, LDA, AFAC, 728 $ LDA, IWORK, EQUED, S, S( N+1 ), B, LDA, X, 729 $ LDA, RCOND, RPVGRW_SVXX, BERR, N_ERR_BNDS, 730 $ ERRBNDS_N, ERRBNDS_C, 0, ZERO, WORK, 731 $ RWORK, INFO ) 732* 733* Check the error code from ZGESVXX. 734* 735 IF( INFO.EQ.N+1 ) GOTO 50 736 IF( INFO.NE.IZERO ) THEN 737 CALL ALAERH( PATH, 'ZGESVXX', INFO, IZERO, 738 $ FACT // TRANS, N, N, -1, -1, NRHS, 739 $ IMAT, NFAIL, NERRS, NOUT ) 740 GOTO 50 741 END IF 742* 743* Compare rpvgrw_svxx from ZGESVXX with the computed 744* reciprocal pivot growth factor RPVGRW 745* 746 747 IF ( INFO .GT. 0 .AND. INFO .LT. N+1 ) THEN 748 RPVGRW = ZLA_GERPVGRW 749 $ (N, INFO, A, LDA, AFAC, LDA) 750 ELSE 751 RPVGRW = ZLA_GERPVGRW 752 $ (N, N, A, LDA, AFAC, LDA) 753 ENDIF 754 755 RESULT( 7 ) = ABS( RPVGRW-rpvgrw_svxx ) / 756 $ MAX( rpvgrw_svxx, RPVGRW ) / 757 $ DLAMCH( 'E' ) 758* 759 IF( .NOT.PREFAC ) THEN 760* 761* Reconstruct matrix from factors and compute 762* residual. 763* 764 CALL ZGET01( N, N, A, LDA, AFAC, LDA, IWORK, 765 $ RWORK( 2*NRHS+1 ), RESULT( 1 ) ) 766 K1 = 1 767 ELSE 768 K1 = 2 769 END IF 770* 771 IF( INFO.EQ.0 ) THEN 772 TRFCON = .FALSE. 773* 774* Compute residual of the computed solution. 775* 776 CALL ZLACPY( 'Full', N, NRHS, BSAV, LDA, WORK, 777 $ LDA ) 778 CALL ZGET02( TRANS, N, N, NRHS, ASAV, LDA, X, 779 $ LDA, WORK, LDA, RWORK( 2*NRHS+1 ), 780 $ RESULT( 2 ) ) 781* 782* Check solution from generated exact solution. 783* 784 IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED, 785 $ 'N' ) ) ) THEN 786 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, 787 $ RCONDC, RESULT( 3 ) ) 788 ELSE 789 IF( ITRAN.EQ.1 ) THEN 790 ROLDC = ROLDO 791 ELSE 792 ROLDC = ROLDI 793 END IF 794 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, 795 $ ROLDC, RESULT( 3 ) ) 796 END IF 797 ELSE 798 TRFCON = .TRUE. 799 END IF 800* 801* Compare RCOND from ZGESVXX with the computed value 802* in RCONDC. 803* 804 RESULT( 6 ) = DGET06( RCOND, RCONDC ) 805* 806* Print information about the tests that did not pass 807* the threshold. 808* 809 IF( .NOT.TRFCON ) THEN 810 DO 45 K = K1, NTESTS 811 IF( RESULT( K ).GE.THRESH ) THEN 812 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 813 $ CALL ALADHD( NOUT, PATH ) 814 IF( PREFAC ) THEN 815 WRITE( NOUT, FMT = 9997 )'ZGESVXX', 816 $ FACT, TRANS, N, EQUED, IMAT, K, 817 $ RESULT( K ) 818 ELSE 819 WRITE( NOUT, FMT = 9998 )'ZGESVXX', 820 $ FACT, TRANS, N, IMAT, K, RESULT( K ) 821 END IF 822 NFAIL = NFAIL + 1 823 END IF 824 45 CONTINUE 825 NRUN = NRUN + 7 - K1 826 ELSE 827 IF( RESULT( 1 ).GE.THRESH .AND. .NOT.PREFAC ) 828 $ THEN 829 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 830 $ CALL ALADHD( NOUT, PATH ) 831 IF( PREFAC ) THEN 832 WRITE( NOUT, FMT = 9997 )'ZGESVXX', FACT, 833 $ TRANS, N, EQUED, IMAT, 1, RESULT( 1 ) 834 ELSE 835 WRITE( NOUT, FMT = 9998 )'ZGESVXX', FACT, 836 $ TRANS, N, IMAT, 1, RESULT( 1 ) 837 END IF 838 NFAIL = NFAIL + 1 839 NRUN = NRUN + 1 840 END IF 841 IF( RESULT( 6 ).GE.THRESH ) THEN 842 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 843 $ CALL ALADHD( NOUT, PATH ) 844 IF( PREFAC ) THEN 845 WRITE( NOUT, FMT = 9997 )'ZGESVXX', FACT, 846 $ TRANS, N, EQUED, IMAT, 6, RESULT( 6 ) 847 ELSE 848 WRITE( NOUT, FMT = 9998 )'ZGESVXX', FACT, 849 $ TRANS, N, IMAT, 6, RESULT( 6 ) 850 END IF 851 NFAIL = NFAIL + 1 852 NRUN = NRUN + 1 853 END IF 854 IF( RESULT( 7 ).GE.THRESH ) THEN 855 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 856 $ CALL ALADHD( NOUT, PATH ) 857 IF( PREFAC ) THEN 858 WRITE( NOUT, FMT = 9997 )'ZGESVXX', FACT, 859 $ TRANS, N, EQUED, IMAT, 7, RESULT( 7 ) 860 ELSE 861 WRITE( NOUT, FMT = 9998 )'ZGESVXX', FACT, 862 $ TRANS, N, IMAT, 7, RESULT( 7 ) 863 END IF 864 NFAIL = NFAIL + 1 865 NRUN = NRUN + 1 866 END IF 867* 868 END IF 869* 870 50 CONTINUE 871 60 CONTINUE 872 70 CONTINUE 873 80 CONTINUE 874 90 CONTINUE 875* 876* Print a summary of the results. 877* 878 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS ) 879* 880 881* Test Error Bounds for ZGESVXX 882 883 CALL ZEBCHVXX(THRESH, PATH) 884 885 9999 FORMAT( 1X, A, ', N =', I5, ', type ', I2, ', test(', I2, ') =', 886 $ G12.5 ) 887 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N=', I5, 888 $ ', type ', I2, ', test(', I1, ')=', G12.5 ) 889 9997 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N=', I5, 890 $ ', EQUED=''', A1, ''', type ', I2, ', test(', I1, ')=', 891 $ G12.5 ) 892 RETURN 893* 894* End of ZDRVGE 895* 896 END 897