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