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