1*> \brief \b SDRVPO 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 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 REAL 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 REAL array, dimension (NMAX*NMAX) 91*> \endverbatim 92*> 93*> \param[out] AFAC 94*> \verbatim 95*> AFAC is REAL array, dimension (NMAX*NMAX) 96*> \endverbatim 97*> 98*> \param[out] ASAV 99*> \verbatim 100*> ASAV is REAL array, dimension (NMAX*NMAX) 101*> \endverbatim 102*> 103*> \param[out] B 104*> \verbatim 105*> B is REAL array, dimension (NMAX*NRHS) 106*> \endverbatim 107*> 108*> \param[out] BSAV 109*> \verbatim 110*> BSAV is REAL array, dimension (NMAX*NRHS) 111*> \endverbatim 112*> 113*> \param[out] X 114*> \verbatim 115*> X is REAL array, dimension (NMAX*NRHS) 116*> \endverbatim 117*> 118*> \param[out] XACT 119*> \verbatim 120*> XACT is REAL array, dimension (NMAX*NRHS) 121*> \endverbatim 122*> 123*> \param[out] S 124*> \verbatim 125*> S is REAL array, dimension (NMAX) 126*> \endverbatim 127*> 128*> \param[out] WORK 129*> \verbatim 130*> WORK is REAL array, dimension 131*> (NMAX*max(3,NRHS)) 132*> \endverbatim 133*> 134*> \param[out] RWORK 135*> \verbatim 136*> RWORK is REAL array, dimension (NMAX+2*NRHS) 137*> \endverbatim 138*> 139*> \param[out] IWORK 140*> \verbatim 141*> IWORK is INTEGER array, dimension (NMAX) 142*> \endverbatim 143*> 144*> \param[in] NOUT 145*> \verbatim 146*> NOUT is INTEGER 147*> The unit number for output. 148*> \endverbatim 149* 150* Authors: 151* ======== 152* 153*> \author Univ. of Tennessee 154*> \author Univ. of California Berkeley 155*> \author Univ. of Colorado Denver 156*> \author NAG Ltd. 157* 158*> \date November 2011 159* 160*> \ingroup single_lin 161* 162* ===================================================================== 163 SUBROUTINE SDRVPO( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, 164 $ A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, 165 $ RWORK, IWORK, NOUT ) 166* 167* -- LAPACK test routine (version 3.4.0) -- 168* -- LAPACK is a software package provided by Univ. of Tennessee, -- 169* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 170* November 2011 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 REAL AINVNM, AMAX, ANORM, CNDNUM, RCOND, RCONDC, 203 $ ROLDC, SCOND 204* .. 205* .. Local Arrays .. 206 CHARACTER EQUEDS( 2 ), FACTS( 3 ), UPLOS( 2 ) 207 INTEGER ISEED( 4 ), ISEEDY( 4 ) 208 REAL RESULT( NTESTS ) 209* .. 210* .. External Functions .. 211 LOGICAL LSAME 212 REAL SGET06, SLANSY 213 EXTERNAL LSAME, SGET06, SLANSY 214* .. 215* .. External Subroutines .. 216 EXTERNAL ALADHD, ALAERH, ALASVM, SERRVX, SGET04, SLACPY, 217 $ SLAQSY, SLARHS, SLASET, SLATB4, SLATMS, SPOEQU, 218 $ SPOSV, SPOSVX, SPOT01, SPOT02, SPOT05, SPOTRF, 219 $ SPOTRI, XLAENV 220* .. 221* .. Intrinsic Functions .. 222 INTRINSIC MAX 223* .. 224* .. Scalars in Common .. 225 LOGICAL LERR, OK 226 CHARACTER*32 SRNAMT 227 INTEGER INFOT, NUNIT 228* .. 229* .. Common blocks .. 230 COMMON / INFOC / INFOT, NUNIT, OK, LERR 231 COMMON / SRNAMC / SRNAMT 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 ) = 'Single 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 SERRVX( 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 SLATB4 and generate a test matrix 294* with SLATMS. 295* 296 CALL SLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE, 297 $ CNDNUM, DIST ) 298* 299 SRNAMT = 'SLATMS' 300 CALL SLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, 301 $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK, 302 $ INFO ) 303* 304* Check error code from SLATMS. 305* 306 IF( INFO.NE.0 ) THEN 307 CALL ALAERH( PATH, 'SLATMS', 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* Save a copy of the matrix A in ASAV. 352* 353 CALL SLACPY( UPLO, N, N, A, LDA, ASAV, LDA ) 354* 355 DO 100 IEQUED = 1, 2 356 EQUED = EQUEDS( IEQUED ) 357 IF( IEQUED.EQ.1 ) THEN 358 NFACT = 3 359 ELSE 360 NFACT = 1 361 END IF 362* 363 DO 90 IFACT = 1, NFACT 364 FACT = FACTS( IFACT ) 365 PREFAC = LSAME( FACT, 'F' ) 366 NOFACT = LSAME( FACT, 'N' ) 367 EQUIL = LSAME( FACT, 'E' ) 368* 369 IF( ZEROT ) THEN 370 IF( PREFAC ) 371 $ GO TO 90 372 RCONDC = ZERO 373* 374 ELSE IF( .NOT.LSAME( FACT, 'N' ) ) THEN 375* 376* Compute the condition number for comparison with 377* the value returned by SPOSVX (FACT = 'N' reuses 378* the condition number from the previous iteration 379* with FACT = 'F'). 380* 381 CALL SLACPY( UPLO, N, N, ASAV, LDA, AFAC, LDA ) 382 IF( EQUIL .OR. IEQUED.GT.1 ) THEN 383* 384* Compute row and column scale factors to 385* equilibrate the matrix A. 386* 387 CALL SPOEQU( N, AFAC, LDA, S, SCOND, AMAX, 388 $ INFO ) 389 IF( INFO.EQ.0 .AND. N.GT.0 ) THEN 390 IF( IEQUED.GT.1 ) 391 $ SCOND = ZERO 392* 393* Equilibrate the matrix. 394* 395 CALL SLAQSY( UPLO, N, AFAC, LDA, S, SCOND, 396 $ AMAX, EQUED ) 397 END IF 398 END IF 399* 400* Save the condition number of the 401* non-equilibrated system for use in SGET04. 402* 403 IF( EQUIL ) 404 $ ROLDC = RCONDC 405* 406* Compute the 1-norm of A. 407* 408 ANORM = SLANSY( '1', UPLO, N, AFAC, LDA, RWORK ) 409* 410* Factor the matrix A. 411* 412 CALL SPOTRF( UPLO, N, AFAC, LDA, INFO ) 413* 414* Form the inverse of A. 415* 416 CALL SLACPY( UPLO, N, N, AFAC, LDA, A, LDA ) 417 CALL SPOTRI( UPLO, N, A, LDA, INFO ) 418* 419* Compute the 1-norm condition number of A. 420* 421 AINVNM = SLANSY( '1', UPLO, N, A, LDA, RWORK ) 422 IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN 423 RCONDC = ONE 424 ELSE 425 RCONDC = ( ONE / ANORM ) / AINVNM 426 END IF 427 END IF 428* 429* Restore the matrix A. 430* 431 CALL SLACPY( UPLO, N, N, ASAV, LDA, A, LDA ) 432* 433* Form an exact solution and set the right hand side. 434* 435 SRNAMT = 'SLARHS' 436 CALL SLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU, 437 $ NRHS, A, LDA, XACT, LDA, B, LDA, 438 $ ISEED, INFO ) 439 XTYPE = 'C' 440 CALL SLACPY( 'Full', N, NRHS, B, LDA, BSAV, LDA ) 441* 442 IF( NOFACT ) THEN 443* 444* --- Test SPOSV --- 445* 446* Compute the L*L' or U'*U factorization of the 447* matrix and solve the system. 448* 449 CALL SLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) 450 CALL SLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) 451* 452 SRNAMT = 'SPOSV ' 453 CALL SPOSV( UPLO, N, NRHS, AFAC, LDA, X, LDA, 454 $ INFO ) 455* 456* Check error code from SPOSV . 457* 458 IF( INFO.NE.IZERO ) THEN 459 CALL ALAERH( PATH, 'SPOSV ', INFO, IZERO, 460 $ UPLO, N, N, -1, -1, NRHS, IMAT, 461 $ NFAIL, NERRS, NOUT ) 462 GO TO 70 463 ELSE IF( INFO.NE.0 ) THEN 464 GO TO 70 465 END IF 466* 467* Reconstruct matrix from factors and compute 468* residual. 469* 470 CALL SPOT01( UPLO, N, A, LDA, AFAC, LDA, RWORK, 471 $ RESULT( 1 ) ) 472* 473* Compute residual of the computed solution. 474* 475 CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, 476 $ LDA ) 477 CALL SPOT02( UPLO, N, NRHS, A, LDA, X, LDA, 478 $ WORK, LDA, RWORK, RESULT( 2 ) ) 479* 480* Check solution from generated exact solution. 481* 482 CALL SGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 483 $ RESULT( 3 ) ) 484 NT = 3 485* 486* Print information about the tests that did not 487* pass the threshold. 488* 489 DO 60 K = 1, NT 490 IF( RESULT( K ).GE.THRESH ) THEN 491 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 492 $ CALL ALADHD( NOUT, PATH ) 493 WRITE( NOUT, FMT = 9999 )'SPOSV ', UPLO, 494 $ N, IMAT, K, RESULT( K ) 495 NFAIL = NFAIL + 1 496 END IF 497 60 CONTINUE 498 NRUN = NRUN + NT 499 70 CONTINUE 500 END IF 501* 502* --- Test SPOSVX --- 503* 504 IF( .NOT.PREFAC ) 505 $ CALL SLASET( UPLO, N, N, ZERO, ZERO, AFAC, LDA ) 506 CALL SLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDA ) 507 IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN 508* 509* Equilibrate the matrix if FACT='F' and 510* EQUED='Y'. 511* 512 CALL SLAQSY( UPLO, N, A, LDA, S, SCOND, AMAX, 513 $ EQUED ) 514 END IF 515* 516* Solve the system and compute the condition number 517* and error bounds using SPOSVX. 518* 519 SRNAMT = 'SPOSVX' 520 CALL SPOSVX( FACT, UPLO, N, NRHS, A, LDA, AFAC, 521 $ LDA, EQUED, S, B, LDA, X, LDA, RCOND, 522 $ RWORK, RWORK( NRHS+1 ), WORK, IWORK, 523 $ INFO ) 524* 525* Check the error code from SPOSVX. 526* 527 IF( INFO.NE.IZERO ) THEN 528 CALL ALAERH( PATH, 'SPOSVX', INFO, IZERO, 529 $ FACT // UPLO, N, N, -1, -1, NRHS, 530 $ IMAT, NFAIL, NERRS, NOUT ) 531 GO TO 90 532 END IF 533* 534 IF( INFO.EQ.0 ) THEN 535 IF( .NOT.PREFAC ) THEN 536* 537* Reconstruct matrix from factors and compute 538* residual. 539* 540 CALL SPOT01( UPLO, N, A, LDA, AFAC, LDA, 541 $ RWORK( 2*NRHS+1 ), RESULT( 1 ) ) 542 K1 = 1 543 ELSE 544 K1 = 2 545 END IF 546* 547* Compute residual of the computed solution. 548* 549 CALL SLACPY( 'Full', N, NRHS, BSAV, LDA, WORK, 550 $ LDA ) 551 CALL SPOT02( UPLO, N, NRHS, ASAV, LDA, X, LDA, 552 $ WORK, LDA, RWORK( 2*NRHS+1 ), 553 $ RESULT( 2 ) ) 554* 555* Check solution from generated exact solution. 556* 557 IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED, 558 $ 'N' ) ) ) THEN 559 CALL SGET04( N, NRHS, X, LDA, XACT, LDA, 560 $ RCONDC, RESULT( 3 ) ) 561 ELSE 562 CALL SGET04( N, NRHS, X, LDA, XACT, LDA, 563 $ ROLDC, RESULT( 3 ) ) 564 END IF 565* 566* Check the error bounds from iterative 567* refinement. 568* 569 CALL SPOT05( UPLO, N, NRHS, ASAV, LDA, B, LDA, 570 $ X, LDA, XACT, LDA, RWORK, 571 $ RWORK( NRHS+1 ), RESULT( 4 ) ) 572 ELSE 573 K1 = 6 574 END IF 575* 576* Compare RCOND from SPOSVX with the computed value 577* in RCONDC. 578* 579 RESULT( 6 ) = SGET06( RCOND, RCONDC ) 580* 581* Print information about the tests that did not pass 582* the threshold. 583* 584 DO 80 K = K1, 6 585 IF( RESULT( K ).GE.THRESH ) THEN 586 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 587 $ CALL ALADHD( NOUT, PATH ) 588 IF( PREFAC ) THEN 589 WRITE( NOUT, FMT = 9997 )'SPOSVX', FACT, 590 $ UPLO, N, EQUED, IMAT, K, RESULT( K ) 591 ELSE 592 WRITE( NOUT, FMT = 9998 )'SPOSVX', FACT, 593 $ UPLO, N, IMAT, K, RESULT( K ) 594 END IF 595 NFAIL = NFAIL + 1 596 END IF 597 80 CONTINUE 598 NRUN = NRUN + 7 - K1 599 90 CONTINUE 600 100 CONTINUE 601 110 CONTINUE 602 120 CONTINUE 603 130 CONTINUE 604* 605* Print a summary of the results. 606* 607 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS ) 608* 609 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I1, 610 $ ', test(', I1, ')=', G12.5 ) 611 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N=', I5, 612 $ ', type ', I1, ', test(', I1, ')=', G12.5 ) 613 9997 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N=', I5, 614 $ ', EQUED=''', A1, ''', type ', I1, ', test(', I1, ') =', 615 $ G12.5 ) 616 RETURN 617* 618* End of SDRVPO 619* 620 END 621