1*> \brief \b DDRVPOX 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 DDRVPO( 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 A( * ), AFAC( * ), ASAV( * ), B( * ), 24* $ BSAV( * ), RWORK( * ), S( * ), WORK( * ), 25* $ X( * ), XACT( * ) 26* .. 27* 28* 29*> \par Purpose: 30* ============= 31*> 32*> \verbatim 33*> 34*> DDRVPO tests the driver routines DPOSV, -SVX, and -SVXX. 35*> 36*> Note that this file is used only when the XBLAS are available, 37*> otherwise ddrvpo.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 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 DOUBLE PRECISION array, dimension (NMAX*NMAX) 94*> \endverbatim 95*> 96*> \param[out] AFAC 97*> \verbatim 98*> AFAC is DOUBLE PRECISION array, dimension (NMAX*NMAX) 99*> \endverbatim 100*> 101*> \param[out] ASAV 102*> \verbatim 103*> ASAV is DOUBLE PRECISION array, dimension (NMAX*NMAX) 104*> \endverbatim 105*> 106*> \param[out] B 107*> \verbatim 108*> B is DOUBLE PRECISION array, dimension (NMAX*NRHS) 109*> \endverbatim 110*> 111*> \param[out] BSAV 112*> \verbatim 113*> BSAV is DOUBLE PRECISION array, dimension (NMAX*NRHS) 114*> \endverbatim 115*> 116*> \param[out] X 117*> \verbatim 118*> X is DOUBLE PRECISION array, dimension (NMAX*NRHS) 119*> \endverbatim 120*> 121*> \param[out] XACT 122*> \verbatim 123*> XACT is DOUBLE PRECISION array, dimension (NMAX*NRHS) 124*> \endverbatim 125*> 126*> \param[out] S 127*> \verbatim 128*> S is DOUBLE PRECISION array, dimension (NMAX) 129*> \endverbatim 130*> 131*> \param[out] WORK 132*> \verbatim 133*> WORK is DOUBLE PRECISION array, dimension 134*> (NMAX*max(3,NRHS)) 135*> \endverbatim 136*> 137*> \param[out] RWORK 138*> \verbatim 139*> RWORK is DOUBLE PRECISION array, dimension (NMAX+2*NRHS) 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 November 2013 162* 163*> \ingroup double_lin 164* 165* ===================================================================== 166 SUBROUTINE DDRVPO( 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.5.0) -- 171* -- LAPACK is a software package provided by Univ. of Tennessee, -- 172* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 173* November 2013 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 A( * ), AFAC( * ), ASAV( * ), B( * ), 184 $ BSAV( * ), RWORK( * ), S( * ), WORK( * ), 185 $ 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 = 9 ) 195 INTEGER NTESTS 196 PARAMETER ( NTESTS = 6 ) 197* .. 198* .. Local Scalars .. 199 LOGICAL EQUIL, NOFACT, PREFAC, ZEROT 200 CHARACTER DIST, EQUED, FACT, TYPE, UPLO, XTYPE 201 CHARACTER*3 PATH 202 INTEGER I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, IUPLO, 203 $ IZERO, K, K1, KL, KU, LDA, MODE, N, NB, NBMIN, 204 $ NERRS, NFACT, NFAIL, NIMAT, NRUN, NT, 205 $ N_ERR_BNDS 206 DOUBLE PRECISION AINVNM, AMAX, ANORM, CNDNUM, RCOND, RCONDC, 207 $ ROLDC, SCOND, RPVGRW_SVXX 208* .. 209* .. Local Arrays .. 210 CHARACTER EQUEDS( 2 ), FACTS( 3 ), UPLOS( 2 ) 211 INTEGER ISEED( 4 ), ISEEDY( 4 ) 212 DOUBLE PRECISION RESULT( NTESTS ), BERR( NRHS ), 213 $ ERRBNDS_N( NRHS, 3 ), ERRBNDS_C( NRHS, 3 ) 214* .. 215* .. External Functions .. 216 LOGICAL LSAME 217 DOUBLE PRECISION DGET06, DLANSY 218 EXTERNAL LSAME, DGET06, DLANSY 219* .. 220* .. External Subroutines .. 221 EXTERNAL ALADHD, ALAERH, ALASVM, DERRVX, DGET04, DLACPY, 222 $ DLAQSY, DLARHS, DLASET, DLATB4, DLATMS, DPOEQU, 223 $ DPOSV, DPOSVX, DPOT01, DPOT02, DPOT05, DPOTRF, 224 $ DPOTRI, XLAENV 225* .. 226* .. Intrinsic Functions .. 227 INTRINSIC MAX 228* .. 229* .. Scalars in Common .. 230 LOGICAL LERR, OK 231 CHARACTER*32 SRNAMT 232 INTEGER INFOT, NUNIT 233* .. 234* .. Common blocks .. 235 COMMON / INFOC / INFOT, NUNIT, OK, LERR 236 COMMON / SRNAMC / SRNAMT 237* .. 238* .. Data statements .. 239 DATA ISEEDY / 1988, 1989, 1990, 1991 / 240 DATA UPLOS / 'U', 'L' / 241 DATA FACTS / 'F', 'N', 'E' / 242 DATA EQUEDS / 'N', 'Y' / 243* .. 244* .. Executable Statements .. 245* 246* Initialize constants and the random number seed. 247* 248 PATH( 1: 1 ) = 'Double precision' 249 PATH( 2: 3 ) = 'PO' 250 NRUN = 0 251 NFAIL = 0 252 NERRS = 0 253 DO 10 I = 1, 4 254 ISEED( I ) = ISEEDY( I ) 255 10 CONTINUE 256* 257* Test the error exits 258* 259 IF( TSTERR ) 260 $ CALL DERRVX( PATH, NOUT ) 261 INFOT = 0 262* 263* Set the block size and minimum block size for testing. 264* 265 NB = 1 266 NBMIN = 2 267 CALL XLAENV( 1, NB ) 268 CALL XLAENV( 2, NBMIN ) 269* 270* Do for each value of N in NVAL 271* 272 DO 130 IN = 1, NN 273 N = NVAL( IN ) 274 LDA = MAX( N, 1 ) 275 XTYPE = 'N' 276 NIMAT = NTYPES 277 IF( N.LE.0 ) 278 $ NIMAT = 1 279* 280 DO 120 IMAT = 1, NIMAT 281* 282* Do the tests only if DOTYPE( IMAT ) is true. 283* 284 IF( .NOT.DOTYPE( IMAT ) ) 285 $ GO TO 120 286* 287* Skip types 3, 4, or 5 if the matrix size is too small. 288* 289 ZEROT = IMAT.GE.3 .AND. IMAT.LE.5 290 IF( ZEROT .AND. N.LT.IMAT-2 ) 291 $ GO TO 120 292* 293* Do first for UPLO = 'U', then for UPLO = 'L' 294* 295 DO 110 IUPLO = 1, 2 296 UPLO = UPLOS( IUPLO ) 297* 298* Set up parameters with DLATB4 and generate a test matrix 299* with DLATMS. 300* 301 CALL DLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE, 302 $ CNDNUM, DIST ) 303* 304 SRNAMT = 'DLATMS' 305 CALL DLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, 306 $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK, 307 $ INFO ) 308* 309* Check error code from DLATMS. 310* 311 IF( INFO.NE.0 ) THEN 312 CALL ALAERH( PATH, 'DLATMS', INFO, 0, UPLO, N, N, -1, 313 $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) 314 GO TO 110 315 END IF 316* 317* For types 3-5, zero one row and column of the matrix to 318* test that INFO is returned correctly. 319* 320 IF( ZEROT ) THEN 321 IF( IMAT.EQ.3 ) THEN 322 IZERO = 1 323 ELSE IF( IMAT.EQ.4 ) THEN 324 IZERO = N 325 ELSE 326 IZERO = N / 2 + 1 327 END IF 328 IOFF = ( IZERO-1 )*LDA 329* 330* Set row and column IZERO of A to 0. 331* 332 IF( IUPLO.EQ.1 ) THEN 333 DO 20 I = 1, IZERO - 1 334 A( IOFF+I ) = ZERO 335 20 CONTINUE 336 IOFF = IOFF + IZERO 337 DO 30 I = IZERO, N 338 A( IOFF ) = ZERO 339 IOFF = IOFF + LDA 340 30 CONTINUE 341 ELSE 342 IOFF = IZERO 343 DO 40 I = 1, IZERO - 1 344 A( IOFF ) = ZERO 345 IOFF = IOFF + LDA 346 40 CONTINUE 347 IOFF = IOFF - IZERO 348 DO 50 I = IZERO, N 349 A( IOFF+I ) = ZERO 350 50 CONTINUE 351 END IF 352 ELSE 353 IZERO = 0 354 END IF 355* 356* Save a copy of the matrix A in ASAV. 357* 358 CALL DLACPY( UPLO, N, N, A, LDA, ASAV, LDA ) 359* 360 DO 100 IEQUED = 1, 2 361 EQUED = EQUEDS( IEQUED ) 362 IF( IEQUED.EQ.1 ) THEN 363 NFACT = 3 364 ELSE 365 NFACT = 1 366 END IF 367* 368 DO 90 IFACT = 1, NFACT 369 FACT = FACTS( IFACT ) 370 PREFAC = LSAME( FACT, 'F' ) 371 NOFACT = LSAME( FACT, 'N' ) 372 EQUIL = LSAME( FACT, 'E' ) 373* 374 IF( ZEROT ) THEN 375 IF( PREFAC ) 376 $ GO TO 90 377 RCONDC = ZERO 378* 379 ELSE IF( .NOT.LSAME( FACT, 'N' ) ) THEN 380* 381* Compute the condition number for comparison with 382* the value returned by DPOSVX (FACT = 'N' reuses 383* the condition number from the previous iteration 384* with FACT = 'F'). 385* 386 CALL DLACPY( UPLO, N, N, ASAV, LDA, AFAC, LDA ) 387 IF( EQUIL .OR. IEQUED.GT.1 ) THEN 388* 389* Compute row and column scale factors to 390* equilibrate the matrix A. 391* 392 CALL DPOEQU( N, AFAC, LDA, S, SCOND, AMAX, 393 $ INFO ) 394 IF( INFO.EQ.0 .AND. N.GT.0 ) THEN 395 IF( IEQUED.GT.1 ) 396 $ SCOND = ZERO 397* 398* Equilibrate the matrix. 399* 400 CALL DLAQSY( UPLO, N, AFAC, LDA, S, SCOND, 401 $ AMAX, EQUED ) 402 END IF 403 END IF 404* 405* Save the condition number of the 406* non-equilibrated system for use in DGET04. 407* 408 IF( EQUIL ) 409 $ ROLDC = RCONDC 410* 411* Compute the 1-norm of A. 412* 413 ANORM = DLANSY( '1', UPLO, N, AFAC, LDA, RWORK ) 414* 415* Factor the matrix A. 416* 417 CALL DPOTRF( UPLO, N, AFAC, LDA, INFO ) 418* 419* Form the inverse of A. 420* 421 CALL DLACPY( UPLO, N, N, AFAC, LDA, A, LDA ) 422 CALL DPOTRI( UPLO, N, A, LDA, INFO ) 423* 424* Compute the 1-norm condition number of A. 425* 426 AINVNM = DLANSY( '1', UPLO, N, A, LDA, RWORK ) 427 IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN 428 RCONDC = ONE 429 ELSE 430 RCONDC = ( ONE / ANORM ) / AINVNM 431 END IF 432 END IF 433* 434* Restore the matrix A. 435* 436 CALL DLACPY( UPLO, N, N, ASAV, LDA, A, LDA ) 437* 438* Form an exact solution and set the right hand side. 439* 440 SRNAMT = 'DLARHS' 441 CALL DLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU, 442 $ NRHS, A, LDA, XACT, LDA, B, LDA, 443 $ ISEED, INFO ) 444 XTYPE = 'C' 445 CALL DLACPY( 'Full', N, NRHS, B, LDA, BSAV, LDA ) 446* 447 IF( NOFACT ) THEN 448* 449* --- Test DPOSV --- 450* 451* Compute the L*L' or U'*U factorization of the 452* matrix and solve the system. 453* 454 CALL DLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) 455 CALL DLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) 456* 457 SRNAMT = 'DPOSV ' 458 CALL DPOSV( UPLO, N, NRHS, AFAC, LDA, X, LDA, 459 $ INFO ) 460* 461* Check error code from DPOSV . 462* 463 IF( INFO.NE.IZERO ) THEN 464 CALL ALAERH( PATH, 'DPOSV ', INFO, IZERO, 465 $ UPLO, N, N, -1, -1, NRHS, IMAT, 466 $ NFAIL, NERRS, NOUT ) 467 GO TO 70 468 ELSE IF( INFO.NE.0 ) THEN 469 GO TO 70 470 END IF 471* 472* Reconstruct matrix from factors and compute 473* residual. 474* 475 CALL DPOT01( UPLO, N, A, LDA, AFAC, LDA, RWORK, 476 $ RESULT( 1 ) ) 477* 478* Compute residual of the computed solution. 479* 480 CALL DLACPY( 'Full', N, NRHS, B, LDA, WORK, 481 $ LDA ) 482 CALL DPOT02( UPLO, N, NRHS, A, LDA, X, LDA, 483 $ WORK, LDA, RWORK, RESULT( 2 ) ) 484* 485* Check solution from generated exact solution. 486* 487 CALL DGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 488 $ RESULT( 3 ) ) 489 NT = 3 490* 491* Print information about the tests that did not 492* pass the threshold. 493* 494 DO 60 K = 1, NT 495 IF( RESULT( K ).GE.THRESH ) THEN 496 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 497 $ CALL ALADHD( NOUT, PATH ) 498 WRITE( NOUT, FMT = 9999 )'DPOSV ', UPLO, 499 $ N, IMAT, K, RESULT( K ) 500 NFAIL = NFAIL + 1 501 END IF 502 60 CONTINUE 503 NRUN = NRUN + NT 504 70 CONTINUE 505 END IF 506* 507* --- Test DPOSVX --- 508* 509 IF( .NOT.PREFAC ) 510 $ CALL DLASET( UPLO, N, N, ZERO, ZERO, AFAC, LDA ) 511 CALL DLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDA ) 512 IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN 513* 514* Equilibrate the matrix if FACT='F' and 515* EQUED='Y'. 516* 517 CALL DLAQSY( UPLO, N, A, LDA, S, SCOND, AMAX, 518 $ EQUED ) 519 END IF 520* 521* Solve the system and compute the condition number 522* and error bounds using DPOSVX. 523* 524 SRNAMT = 'DPOSVX' 525 CALL DPOSVX( FACT, UPLO, N, NRHS, A, LDA, AFAC, 526 $ LDA, EQUED, S, B, LDA, X, LDA, RCOND, 527 $ RWORK, RWORK( NRHS+1 ), WORK, IWORK, 528 $ INFO ) 529* 530* Check the error code from DPOSVX. 531* 532 IF( INFO.NE.IZERO ) THEN 533 CALL ALAERH( PATH, 'DPOSVX', INFO, IZERO, 534 $ FACT // UPLO, N, N, -1, -1, NRHS, 535 $ IMAT, NFAIL, NERRS, NOUT ) 536 GO TO 90 537 END IF 538* 539 IF( INFO.EQ.0 ) THEN 540 IF( .NOT.PREFAC ) THEN 541* 542* Reconstruct matrix from factors and compute 543* residual. 544* 545 CALL DPOT01( UPLO, N, A, LDA, AFAC, LDA, 546 $ RWORK( 2*NRHS+1 ), RESULT( 1 ) ) 547 K1 = 1 548 ELSE 549 K1 = 2 550 END IF 551* 552* Compute residual of the computed solution. 553* 554 CALL DLACPY( 'Full', N, NRHS, BSAV, LDA, WORK, 555 $ LDA ) 556 CALL DPOT02( UPLO, N, NRHS, ASAV, LDA, X, LDA, 557 $ WORK, LDA, RWORK( 2*NRHS+1 ), 558 $ RESULT( 2 ) ) 559* 560* Check solution from generated exact solution. 561* 562 IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED, 563 $ 'N' ) ) ) THEN 564 CALL DGET04( N, NRHS, X, LDA, XACT, LDA, 565 $ RCONDC, RESULT( 3 ) ) 566 ELSE 567 CALL DGET04( N, NRHS, X, LDA, XACT, LDA, 568 $ ROLDC, RESULT( 3 ) ) 569 END IF 570* 571* Check the error bounds from iterative 572* refinement. 573* 574 CALL DPOT05( UPLO, N, NRHS, ASAV, LDA, B, LDA, 575 $ X, LDA, XACT, LDA, RWORK, 576 $ RWORK( NRHS+1 ), RESULT( 4 ) ) 577 ELSE 578 K1 = 6 579 END IF 580* 581* Compare RCOND from DPOSVX with the computed value 582* in RCONDC. 583* 584 RESULT( 6 ) = DGET06( RCOND, RCONDC ) 585* 586* Print information about the tests that did not pass 587* the threshold. 588* 589 DO 80 K = K1, 6 590 IF( RESULT( K ).GE.THRESH ) THEN 591 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 592 $ CALL ALADHD( NOUT, PATH ) 593 IF( PREFAC ) THEN 594 WRITE( NOUT, FMT = 9997 )'DPOSVX', FACT, 595 $ UPLO, N, EQUED, IMAT, K, RESULT( K ) 596 ELSE 597 WRITE( NOUT, FMT = 9998 )'DPOSVX', FACT, 598 $ UPLO, N, IMAT, K, RESULT( K ) 599 END IF 600 NFAIL = NFAIL + 1 601 END IF 602 80 CONTINUE 603 NRUN = NRUN + 7 - K1 604* 605* --- Test DPOSVXX --- 606* 607* Restore the matrices A and B. 608* 609 CALL DLACPY( 'Full', N, N, ASAV, LDA, A, LDA ) 610 CALL DLACPY( 'Full', N, NRHS, BSAV, LDA, B, LDA ) 611 612 IF( .NOT.PREFAC ) 613 $ CALL DLASET( UPLO, N, N, ZERO, ZERO, AFAC, LDA ) 614 CALL DLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDA ) 615 IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN 616* 617* Equilibrate the matrix if FACT='F' and 618* EQUED='Y'. 619* 620 CALL DLAQSY( UPLO, N, A, LDA, S, SCOND, AMAX, 621 $ EQUED ) 622 END IF 623* 624* Solve the system and compute the condition number 625* and error bounds using DPOSVXX. 626* 627 SRNAMT = 'DPOSVXX' 628 N_ERR_BNDS = 3 629 CALL DPOSVXX( FACT, UPLO, N, NRHS, A, LDA, AFAC, 630 $ LDA, EQUED, S, B, LDA, X, 631 $ LDA, RCOND, RPVGRW_SVXX, BERR, N_ERR_BNDS, 632 $ ERRBNDS_N, ERRBNDS_C, 0, ZERO, WORK, 633 $ IWORK, INFO ) 634* 635* Check the error code from DPOSVXX. 636* 637 IF( INFO.EQ.N+1 ) GOTO 90 638 IF( INFO.NE.IZERO ) THEN 639 CALL ALAERH( PATH, 'DPOSVXX', INFO, IZERO, 640 $ FACT // UPLO, N, N, -1, -1, NRHS, 641 $ IMAT, NFAIL, NERRS, NOUT ) 642 GO TO 90 643 END IF 644* 645 IF( INFO.EQ.0 ) THEN 646 IF( .NOT.PREFAC ) THEN 647* 648* Reconstruct matrix from factors and compute 649* residual. 650* 651 CALL DPOT01( UPLO, N, A, LDA, AFAC, LDA, 652 $ RWORK( 2*NRHS+1 ), RESULT( 1 ) ) 653 K1 = 1 654 ELSE 655 K1 = 2 656 END IF 657* 658* Compute residual of the computed solution. 659* 660 CALL DLACPY( 'Full', N, NRHS, BSAV, LDA, WORK, 661 $ LDA ) 662 CALL DPOT02( UPLO, N, NRHS, ASAV, LDA, X, LDA, 663 $ WORK, LDA, RWORK( 2*NRHS+1 ), 664 $ RESULT( 2 ) ) 665* 666* Check solution from generated exact solution. 667* 668 IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED, 669 $ 'N' ) ) ) THEN 670 CALL DGET04( N, NRHS, X, LDA, XACT, LDA, 671 $ RCONDC, RESULT( 3 ) ) 672 ELSE 673 CALL DGET04( N, NRHS, X, LDA, XACT, LDA, 674 $ ROLDC, RESULT( 3 ) ) 675 END IF 676* 677* Check the error bounds from iterative 678* refinement. 679* 680 CALL DPOT05( UPLO, N, NRHS, ASAV, LDA, B, LDA, 681 $ X, LDA, XACT, LDA, RWORK, 682 $ RWORK( NRHS+1 ), RESULT( 4 ) ) 683 ELSE 684 K1 = 6 685 END IF 686* 687* Compare RCOND from DPOSVXX with the computed value 688* in RCONDC. 689* 690 RESULT( 6 ) = DGET06( RCOND, RCONDC ) 691* 692* Print information about the tests that did not pass 693* the threshold. 694* 695 DO 85 K = K1, 6 696 IF( RESULT( K ).GE.THRESH ) THEN 697 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 698 $ CALL ALADHD( NOUT, PATH ) 699 IF( PREFAC ) THEN 700 WRITE( NOUT, FMT = 9997 )'DPOSVXX', FACT, 701 $ UPLO, N, EQUED, IMAT, K, RESULT( K ) 702 ELSE 703 WRITE( NOUT, FMT = 9998 )'DPOSVXX', FACT, 704 $ UPLO, N, IMAT, K, RESULT( K ) 705 END IF 706 NFAIL = NFAIL + 1 707 END IF 708 85 CONTINUE 709 NRUN = NRUN + 7 - K1 710 90 CONTINUE 711 100 CONTINUE 712 110 CONTINUE 713 120 CONTINUE 714 130 CONTINUE 715* 716* Print a summary of the results. 717* 718 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS ) 719* 720 721* Test Error Bounds from DPOSVXX 722 723 CALL DEBCHVXX( THRESH, PATH ) 724 725 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I1, 726 $ ', test(', I1, ')=', G12.5 ) 727 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N=', I5, 728 $ ', type ', I1, ', test(', I1, ')=', G12.5 ) 729 9997 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N=', I5, 730 $ ', EQUED=''', A1, ''', type ', I1, ', test(', I1, ') =', 731 $ G12.5 ) 732 RETURN 733* 734* End of DDRVPO 735* 736 END 737