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