1*> \brief \b SDRVSY 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 SDRVSY( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, 12* A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, 13* 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( * ), AINV( * ), B( * ), 24* $ RWORK( * ), WORK( * ), X( * ), XACT( * ) 25* .. 26* 27* 28*> \par Purpose: 29* ============= 30*> 31*> \verbatim 32*> 33*> SDRVSY tests the driver routines SSYSV and -SVX. 34*> \endverbatim 35* 36* Arguments: 37* ========== 38* 39*> \param[in] DOTYPE 40*> \verbatim 41*> DOTYPE is LOGICAL array, dimension (NTYPES) 42*> The matrix types to be used for testing. Matrices of type j 43*> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = 44*> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. 45*> \endverbatim 46*> 47*> \param[in] NN 48*> \verbatim 49*> NN is INTEGER 50*> The number of values of N contained in the vector NVAL. 51*> \endverbatim 52*> 53*> \param[in] NVAL 54*> \verbatim 55*> NVAL is INTEGER array, dimension (NN) 56*> The values of the matrix dimension N. 57*> \endverbatim 58*> 59*> \param[in] NRHS 60*> \verbatim 61*> NRHS is INTEGER 62*> The number of right hand side vectors to be generated for 63*> each linear system. 64*> \endverbatim 65*> 66*> \param[in] THRESH 67*> \verbatim 68*> THRESH is REAL 69*> The threshold value for the test ratios. A result is 70*> included in the output file if RESULT >= THRESH. To have 71*> every test ratio printed, use THRESH = 0. 72*> \endverbatim 73*> 74*> \param[in] TSTERR 75*> \verbatim 76*> TSTERR is LOGICAL 77*> Flag that indicates whether error exits are to be tested. 78*> \endverbatim 79*> 80*> \param[in] NMAX 81*> \verbatim 82*> NMAX is INTEGER 83*> The maximum value permitted for N, used in dimensioning the 84*> work arrays. 85*> \endverbatim 86*> 87*> \param[out] A 88*> \verbatim 89*> A is REAL array, dimension (NMAX*NMAX) 90*> \endverbatim 91*> 92*> \param[out] AFAC 93*> \verbatim 94*> AFAC is REAL array, dimension (NMAX*NMAX) 95*> \endverbatim 96*> 97*> \param[out] AINV 98*> \verbatim 99*> AINV is REAL array, dimension (NMAX*NMAX) 100*> \endverbatim 101*> 102*> \param[out] B 103*> \verbatim 104*> B is REAL array, dimension (NMAX*NRHS) 105*> \endverbatim 106*> 107*> \param[out] X 108*> \verbatim 109*> X is REAL array, dimension (NMAX*NRHS) 110*> \endverbatim 111*> 112*> \param[out] XACT 113*> \verbatim 114*> XACT is REAL array, dimension (NMAX*NRHS) 115*> \endverbatim 116*> 117*> \param[out] WORK 118*> \verbatim 119*> WORK is REAL array, dimension 120*> (NMAX*max(2,NRHS)) 121*> \endverbatim 122*> 123*> \param[out] RWORK 124*> \verbatim 125*> RWORK is REAL array, dimension (NMAX+2*NRHS) 126*> \endverbatim 127*> 128*> \param[out] IWORK 129*> \verbatim 130*> IWORK is INTEGER array, dimension (2*NMAX) 131*> \endverbatim 132*> 133*> \param[in] NOUT 134*> \verbatim 135*> NOUT is INTEGER 136*> The unit number for output. 137*> \endverbatim 138* 139* Authors: 140* ======== 141* 142*> \author Univ. of Tennessee 143*> \author Univ. of California Berkeley 144*> \author Univ. of Colorado Denver 145*> \author NAG Ltd. 146* 147*> \date November 2011 148* 149*> \ingroup single_lin 150* 151* ===================================================================== 152 SUBROUTINE SDRVSY( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, 153 $ A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, 154 $ NOUT ) 155* 156* -- LAPACK test routine (version 3.4.0) -- 157* -- LAPACK is a software package provided by Univ. of Tennessee, -- 158* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 159* November 2011 160* 161* .. Scalar Arguments .. 162 LOGICAL TSTERR 163 INTEGER NMAX, NN, NOUT, NRHS 164 REAL THRESH 165* .. 166* .. Array Arguments .. 167 LOGICAL DOTYPE( * ) 168 INTEGER IWORK( * ), NVAL( * ) 169 REAL A( * ), AFAC( * ), AINV( * ), B( * ), 170 $ RWORK( * ), WORK( * ), X( * ), XACT( * ) 171* .. 172* 173* ===================================================================== 174* 175* .. Parameters .. 176 REAL ONE, ZERO 177 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 178 INTEGER NTYPES, NTESTS 179 PARAMETER ( NTYPES = 10, NTESTS = 6 ) 180 INTEGER NFACT 181 PARAMETER ( NFACT = 2 ) 182* .. 183* .. Local Scalars .. 184 LOGICAL ZEROT 185 CHARACTER DIST, FACT, TYPE, UPLO, XTYPE 186 CHARACTER*3 PATH 187 INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO, 188 $ IZERO, J, K, K1, KL, KU, LDA, LWORK, MODE, N, 189 $ NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT 190 REAL AINVNM, ANORM, CNDNUM, RCOND, RCONDC 191* .. 192* .. Local Arrays .. 193 CHARACTER FACTS( NFACT ), UPLOS( 2 ) 194 INTEGER ISEED( 4 ), ISEEDY( 4 ) 195 REAL RESULT( NTESTS ) 196* .. 197* .. External Functions .. 198 REAL SGET06, SLANSY 199 EXTERNAL SGET06, SLANSY 200* .. 201* .. External Subroutines .. 202 EXTERNAL ALADHD, ALAERH, ALASVM, SERRVX, SGET04, SLACPY, 203 $ SLARHS, SLASET, SLATB4, SLATMS, SPOT02, SPOT05, 204 $ SSYSV, SSYSVX, SSYT01, SSYTRF, SSYTRI2, XLAENV 205* .. 206* .. Scalars in Common .. 207 LOGICAL LERR, OK 208 CHARACTER*32 SRNAMT 209 INTEGER INFOT, NUNIT 210* .. 211* .. Common blocks .. 212 COMMON / INFOC / INFOT, NUNIT, OK, LERR 213 COMMON / SRNAMC / SRNAMT 214* .. 215* .. Intrinsic Functions .. 216 INTRINSIC MAX, MIN 217* .. 218* .. Data statements .. 219 DATA ISEEDY / 1988, 1989, 1990, 1991 / 220 DATA UPLOS / 'U', 'L' / , FACTS / 'F', 'N' / 221* .. 222* .. Executable Statements .. 223* 224* Initialize constants and the random number seed. 225* 226 PATH( 1: 1 ) = 'Single precision' 227 PATH( 2: 3 ) = 'SY' 228 NRUN = 0 229 NFAIL = 0 230 NERRS = 0 231 DO 10 I = 1, 4 232 ISEED( I ) = ISEEDY( I ) 233 10 CONTINUE 234 LWORK = MAX( 2*NMAX, NMAX*NRHS ) 235* 236* Test the error exits 237* 238 IF( TSTERR ) 239 $ CALL SERRVX( PATH, NOUT ) 240 INFOT = 0 241* 242* Set the block size and minimum block size for testing. 243* 244 NB = 1 245 NBMIN = 2 246 CALL XLAENV( 1, NB ) 247 CALL XLAENV( 2, NBMIN ) 248* 249* Do for each value of N in NVAL 250* 251 DO 180 IN = 1, NN 252 N = NVAL( IN ) 253 LDA = MAX( N, 1 ) 254 XTYPE = 'N' 255 NIMAT = NTYPES 256 IF( N.LE.0 ) 257 $ NIMAT = 1 258* 259 DO 170 IMAT = 1, NIMAT 260* 261* Do the tests only if DOTYPE( IMAT ) is true. 262* 263 IF( .NOT.DOTYPE( IMAT ) ) 264 $ GO TO 170 265* 266* Skip types 3, 4, 5, or 6 if the matrix size is too small. 267* 268 ZEROT = IMAT.GE.3 .AND. IMAT.LE.6 269 IF( ZEROT .AND. N.LT.IMAT-2 ) 270 $ GO TO 170 271* 272* Do first for UPLO = 'U', then for UPLO = 'L' 273* 274 DO 160 IUPLO = 1, 2 275 UPLO = UPLOS( IUPLO ) 276* 277* Set up parameters with SLATB4 and generate a test matrix 278* with SLATMS. 279* 280 CALL SLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE, 281 $ CNDNUM, DIST ) 282* 283 SRNAMT = 'SLATMS' 284 CALL SLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, 285 $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK, 286 $ INFO ) 287* 288* Check error code from SLATMS. 289* 290 IF( INFO.NE.0 ) THEN 291 CALL ALAERH( PATH, 'SLATMS', INFO, 0, UPLO, N, N, -1, 292 $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) 293 GO TO 160 294 END IF 295* 296* For types 3-6, zero one or more rows and columns of the 297* matrix to test that INFO is returned correctly. 298* 299 IF( ZEROT ) THEN 300 IF( IMAT.EQ.3 ) THEN 301 IZERO = 1 302 ELSE IF( IMAT.EQ.4 ) THEN 303 IZERO = N 304 ELSE 305 IZERO = N / 2 + 1 306 END IF 307* 308 IF( IMAT.LT.6 ) THEN 309* 310* Set row and column IZERO to zero. 311* 312 IF( IUPLO.EQ.1 ) THEN 313 IOFF = ( IZERO-1 )*LDA 314 DO 20 I = 1, IZERO - 1 315 A( IOFF+I ) = ZERO 316 20 CONTINUE 317 IOFF = IOFF + IZERO 318 DO 30 I = IZERO, N 319 A( IOFF ) = ZERO 320 IOFF = IOFF + LDA 321 30 CONTINUE 322 ELSE 323 IOFF = IZERO 324 DO 40 I = 1, IZERO - 1 325 A( IOFF ) = ZERO 326 IOFF = IOFF + LDA 327 40 CONTINUE 328 IOFF = IOFF - IZERO 329 DO 50 I = IZERO, N 330 A( IOFF+I ) = ZERO 331 50 CONTINUE 332 END IF 333 ELSE 334 IOFF = 0 335 IF( IUPLO.EQ.1 ) THEN 336* 337* Set the first IZERO rows and columns to zero. 338* 339 DO 70 J = 1, N 340 I2 = MIN( J, IZERO ) 341 DO 60 I = 1, I2 342 A( IOFF+I ) = ZERO 343 60 CONTINUE 344 IOFF = IOFF + LDA 345 70 CONTINUE 346 ELSE 347* 348* Set the last IZERO rows and columns to zero. 349* 350 DO 90 J = 1, N 351 I1 = MAX( J, IZERO ) 352 DO 80 I = I1, N 353 A( IOFF+I ) = ZERO 354 80 CONTINUE 355 IOFF = IOFF + LDA 356 90 CONTINUE 357 END IF 358 END IF 359 ELSE 360 IZERO = 0 361 END IF 362* 363 DO 150 IFACT = 1, NFACT 364* 365* Do first for FACT = 'F', then for other values. 366* 367 FACT = FACTS( IFACT ) 368* 369* Compute the condition number for comparison with 370* the value returned by SSYSVX. 371* 372 IF( ZEROT ) THEN 373 IF( IFACT.EQ.1 ) 374 $ GO TO 150 375 RCONDC = ZERO 376* 377 ELSE IF( IFACT.EQ.1 ) THEN 378* 379* Compute the 1-norm of A. 380* 381 ANORM = SLANSY( '1', UPLO, N, A, LDA, RWORK ) 382* 383* Factor the matrix A. 384* 385 CALL SLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) 386 CALL SSYTRF( UPLO, N, AFAC, LDA, IWORK, WORK, 387 $ LWORK, INFO ) 388* 389* Compute inv(A) and take its norm. 390* 391 CALL SLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA ) 392 LWORK = (N+NB+1)*(NB+3) 393 CALL SSYTRI2( UPLO, N, AINV, LDA, IWORK, WORK, 394 $ LWORK, INFO ) 395 AINVNM = SLANSY( '1', UPLO, N, AINV, LDA, RWORK ) 396* 397* Compute the 1-norm condition number of A. 398* 399 IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN 400 RCONDC = ONE 401 ELSE 402 RCONDC = ( ONE / ANORM ) / AINVNM 403 END IF 404 END IF 405* 406* Form an exact solution and set the right hand side. 407* 408 SRNAMT = 'SLARHS' 409 CALL SLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU, 410 $ NRHS, A, LDA, XACT, LDA, B, LDA, ISEED, 411 $ INFO ) 412 XTYPE = 'C' 413* 414* --- Test SSYSV --- 415* 416 IF( IFACT.EQ.2 ) THEN 417 CALL SLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) 418 CALL SLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) 419* 420* Factor the matrix and solve the system using SSYSV. 421* 422 SRNAMT = 'SSYSV ' 423 CALL SSYSV( UPLO, N, NRHS, AFAC, LDA, IWORK, X, 424 $ LDA, WORK, LWORK, INFO ) 425* 426* Adjust the expected value of INFO to account for 427* pivoting. 428* 429 K = IZERO 430 IF( K.GT.0 ) THEN 431 100 CONTINUE 432 IF( IWORK( K ).LT.0 ) THEN 433 IF( IWORK( K ).NE.-K ) THEN 434 K = -IWORK( K ) 435 GO TO 100 436 END IF 437 ELSE IF( IWORK( K ).NE.K ) THEN 438 K = IWORK( K ) 439 GO TO 100 440 END IF 441 END IF 442* 443* Check error code from SSYSV . 444* 445 IF( INFO.NE.K ) THEN 446 CALL ALAERH( PATH, 'SSYSV ', INFO, K, UPLO, N, 447 $ N, -1, -1, NRHS, IMAT, NFAIL, 448 $ NERRS, NOUT ) 449 GO TO 120 450 ELSE IF( INFO.NE.0 ) THEN 451 GO TO 120 452 END IF 453* 454* Reconstruct matrix from factors and compute 455* residual. 456* 457 CALL SSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK, 458 $ AINV, LDA, RWORK, RESULT( 1 ) ) 459* 460* Compute residual of the computed solution. 461* 462 CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) 463 CALL SPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, 464 $ LDA, RWORK, RESULT( 2 ) ) 465* 466* Check solution from generated exact solution. 467* 468 CALL SGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 469 $ RESULT( 3 ) ) 470 NT = 3 471* 472* Print information about the tests that did not pass 473* the threshold. 474* 475 DO 110 K = 1, NT 476 IF( RESULT( K ).GE.THRESH ) THEN 477 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 478 $ CALL ALADHD( NOUT, PATH ) 479 WRITE( NOUT, FMT = 9999 )'SSYSV ', UPLO, N, 480 $ IMAT, K, RESULT( K ) 481 NFAIL = NFAIL + 1 482 END IF 483 110 CONTINUE 484 NRUN = NRUN + NT 485 120 CONTINUE 486 END IF 487* 488* --- Test SSYSVX --- 489* 490 IF( IFACT.EQ.2 ) 491 $ CALL SLASET( UPLO, N, N, ZERO, ZERO, AFAC, LDA ) 492 CALL SLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDA ) 493* 494* Solve the system and compute the condition number and 495* error bounds using SSYSVX. 496* 497 SRNAMT = 'SSYSVX' 498 CALL SSYSVX( FACT, UPLO, N, NRHS, A, LDA, AFAC, LDA, 499 $ IWORK, B, LDA, X, LDA, RCOND, RWORK, 500 $ RWORK( NRHS+1 ), WORK, LWORK, 501 $ IWORK( N+1 ), INFO ) 502* 503* Adjust the expected value of INFO to account for 504* pivoting. 505* 506 K = IZERO 507 IF( K.GT.0 ) THEN 508 130 CONTINUE 509 IF( IWORK( K ).LT.0 ) THEN 510 IF( IWORK( K ).NE.-K ) THEN 511 K = -IWORK( K ) 512 GO TO 130 513 END IF 514 ELSE IF( IWORK( K ).NE.K ) THEN 515 K = IWORK( K ) 516 GO TO 130 517 END IF 518 END IF 519* 520* Check the error code from SSYSVX. 521* 522 IF( INFO.NE.K ) THEN 523 CALL ALAERH( PATH, 'SSYSVX', INFO, K, FACT // UPLO, 524 $ N, N, -1, -1, NRHS, IMAT, NFAIL, 525 $ NERRS, NOUT ) 526 GO TO 150 527 END IF 528* 529 IF( INFO.EQ.0 ) THEN 530 IF( IFACT.GE.2 ) THEN 531* 532* Reconstruct matrix from factors and compute 533* residual. 534* 535 CALL SSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK, 536 $ AINV, LDA, RWORK( 2*NRHS+1 ), 537 $ RESULT( 1 ) ) 538 K1 = 1 539 ELSE 540 K1 = 2 541 END IF 542* 543* Compute residual of the computed solution. 544* 545 CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) 546 CALL SPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, 547 $ LDA, RWORK( 2*NRHS+1 ), RESULT( 2 ) ) 548* 549* Check solution from generated exact solution. 550* 551 CALL SGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 552 $ RESULT( 3 ) ) 553* 554* Check the error bounds from iterative refinement. 555* 556 CALL SPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA, 557 $ XACT, LDA, RWORK, RWORK( NRHS+1 ), 558 $ RESULT( 4 ) ) 559 ELSE 560 K1 = 6 561 END IF 562* 563* Compare RCOND from SSYSVX with the computed value 564* in RCONDC. 565* 566 RESULT( 6 ) = SGET06( RCOND, RCONDC ) 567* 568* Print information about the tests that did not pass 569* the threshold. 570* 571 DO 140 K = K1, 6 572 IF( RESULT( K ).GE.THRESH ) THEN 573 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 574 $ CALL ALADHD( NOUT, PATH ) 575 WRITE( NOUT, FMT = 9998 )'SSYSVX', FACT, UPLO, 576 $ N, IMAT, K, RESULT( K ) 577 NFAIL = NFAIL + 1 578 END IF 579 140 CONTINUE 580 NRUN = NRUN + 7 - K1 581* 582 150 CONTINUE 583* 584 160 CONTINUE 585 170 CONTINUE 586 180 CONTINUE 587* 588* Print a summary of the results. 589* 590 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS ) 591* 592 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2, 593 $ ', test ', I2, ', ratio =', G12.5 ) 594 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N =', I5, 595 $ ', type ', I2, ', test ', I2, ', ratio =', G12.5 ) 596 RETURN 597* 598* End of SDRVSY 599* 600 END 601