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