1*> \brief \b SCHKSY 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 SCHKSY( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, 12* THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, 13* XACT, WORK, RWORK, IWORK, NOUT ) 14* 15* .. Scalar Arguments .. 16* LOGICAL TSTERR 17* INTEGER NMAX, NN, NNB, NNS, NOUT 18* REAL THRESH 19* .. 20* .. Array Arguments .. 21* LOGICAL DOTYPE( * ) 22* INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * ) 23* REAL A( * ), AFAC( * ), AINV( * ), B( * ), 24* $ RWORK( * ), WORK( * ), X( * ), XACT( * ) 25* .. 26* 27* 28*> \par Purpose: 29* ============= 30*> 31*> \verbatim 32*> 33*> SCHKSY tests SSYTRF, -TRI2, -TRS, -TRS2, -RFS, and -CON. 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] NNB 60*> \verbatim 61*> NNB is INTEGER 62*> The number of values of NB contained in the vector NBVAL. 63*> \endverbatim 64*> 65*> \param[in] NBVAL 66*> \verbatim 67*> NBVAL is INTEGER array, dimension (NNB) 68*> The values of the blocksize NB. 69*> \endverbatim 70*> 71*> \param[in] NNS 72*> \verbatim 73*> NNS is INTEGER 74*> The number of values of NRHS contained in the vector NSVAL. 75*> \endverbatim 76*> 77*> \param[in] NSVAL 78*> \verbatim 79*> NSVAL is INTEGER array, dimension (NNS) 80*> The values of the number of right hand sides NRHS. 81*> \endverbatim 82*> 83*> \param[in] THRESH 84*> \verbatim 85*> THRESH is REAL 86*> The threshold value for the test ratios. A result is 87*> included in the output file if RESULT >= THRESH. To have 88*> every test ratio printed, use THRESH = 0. 89*> \endverbatim 90*> 91*> \param[in] TSTERR 92*> \verbatim 93*> TSTERR is LOGICAL 94*> Flag that indicates whether error exits are to be tested. 95*> \endverbatim 96*> 97*> \param[in] NMAX 98*> \verbatim 99*> NMAX is INTEGER 100*> The maximum value permitted for N, used in dimensioning the 101*> work arrays. 102*> \endverbatim 103*> 104*> \param[out] A 105*> \verbatim 106*> A is REAL array, dimension (NMAX*NMAX) 107*> \endverbatim 108*> 109*> \param[out] AFAC 110*> \verbatim 111*> AFAC is REAL array, dimension (NMAX*NMAX) 112*> \endverbatim 113*> 114*> \param[out] AINV 115*> \verbatim 116*> AINV is REAL array, dimension (NMAX*NMAX) 117*> \endverbatim 118*> 119*> \param[out] B 120*> \verbatim 121*> B is REAL array, dimension (NMAX*NSMAX) 122*> where NSMAX is the largest entry in NSVAL. 123*> \endverbatim 124*> 125*> \param[out] X 126*> \verbatim 127*> X is REAL array, dimension (NMAX*NSMAX) 128*> \endverbatim 129*> 130*> \param[out] XACT 131*> \verbatim 132*> XACT is REAL array, dimension (NMAX*NSMAX) 133*> \endverbatim 134*> 135*> \param[out] WORK 136*> \verbatim 137*> WORK is REAL array, dimension (NMAX*max(3,NSMAX)) 138*> \endverbatim 139*> 140*> \param[out] RWORK 141*> \verbatim 142*> RWORK is REAL array, dimension (max(NMAX,2*NSMAX)) 143*> \endverbatim 144*> 145*> \param[out] IWORK 146*> \verbatim 147*> IWORK is INTEGER array, dimension (2*NMAX) 148*> \endverbatim 149*> 150*> \param[in] NOUT 151*> \verbatim 152*> NOUT is INTEGER 153*> The unit number for output. 154*> \endverbatim 155* 156* Authors: 157* ======== 158* 159*> \author Univ. of Tennessee 160*> \author Univ. of California Berkeley 161*> \author Univ. of Colorado Denver 162*> \author NAG Ltd. 163* 164*> \ingroup single_lin 165* 166* ===================================================================== 167 SUBROUTINE SCHKSY( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, 168 $ THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, 169 $ XACT, WORK, RWORK, IWORK, NOUT ) 170* 171* -- LAPACK test routine -- 172* -- LAPACK is a software package provided by Univ. of Tennessee, -- 173* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 174* 175* .. Scalar Arguments .. 176 LOGICAL TSTERR 177 INTEGER NMAX, NN, NNB, NNS, NOUT 178 REAL THRESH 179* .. 180* .. Array Arguments .. 181 LOGICAL DOTYPE( * ) 182 INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * ) 183 REAL A( * ), AFAC( * ), AINV( * ), B( * ), 184 $ RWORK( * ), WORK( * ), X( * ), XACT( * ) 185* .. 186* 187* ===================================================================== 188* 189* .. Parameters .. 190 REAL ZERO 191 PARAMETER ( ZERO = 0.0E+0 ) 192 INTEGER NTYPES 193 PARAMETER ( NTYPES = 10 ) 194 INTEGER NTESTS 195 PARAMETER ( NTESTS = 9 ) 196* .. 197* .. Local Scalars .. 198 LOGICAL TRFCON, ZEROT 199 CHARACTER DIST, TYPE, UPLO, XTYPE 200 CHARACTER*3 PATH 201 INTEGER I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS, 202 $ IUPLO, IZERO, J, K, KL, KU, LDA, LWORK, MODE, 203 $ N, NB, NERRS, NFAIL, NIMAT, NRHS, NRUN, NT 204 REAL ANORM, CNDNUM, RCOND, RCONDC 205* .. 206* .. Local Arrays .. 207 CHARACTER UPLOS( 2 ) 208 INTEGER ISEED( 4 ), ISEEDY( 4 ) 209 REAL RESULT( NTESTS ) 210* .. 211* .. External Functions .. 212 REAL SGET06, SLANSY 213 EXTERNAL SGET06, SLANSY 214* .. 215* .. External Subroutines .. 216 EXTERNAL ALAERH, ALAHD, ALASUM, SERRSY, SGET04, SLACPY, 217 $ SLARHS, SLATB4, SLATMS, SPOT02, SPOT03, SPOT05, 218 $ SSYCON, SSYCONV, SSYRFS, SSYT01, SSYTRF, 219 $ SSYTRI2, SSYTRS, SSYTRS2, XLAENV 220* .. 221* .. Intrinsic Functions .. 222 INTRINSIC MAX, MIN 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* .. 237* .. Executable Statements .. 238* 239* Initialize constants and the random number seed. 240* 241 PATH( 1: 1 ) = 'Single precision' 242 PATH( 2: 3 ) = 'SY' 243 NRUN = 0 244 NFAIL = 0 245 NERRS = 0 246 DO 10 I = 1, 4 247 ISEED( I ) = ISEEDY( I ) 248 10 CONTINUE 249* 250* Test the error exits 251* 252 IF( TSTERR ) 253 $ CALL SERRSY( PATH, NOUT ) 254 INFOT = 0 255* 256* Set the minimum block size for which the block routine should 257* be used, which will be later returned by ILAENV 258* 259 CALL XLAENV( 2, 2 ) 260* 261* Do for each value of N in NVAL 262* 263 DO 180 IN = 1, NN 264 N = NVAL( IN ) 265 LDA = MAX( N, 1 ) 266 XTYPE = 'N' 267 NIMAT = NTYPES 268 IF( N.LE.0 ) 269 $ NIMAT = 1 270* 271 IZERO = 0 272* 273* Do for each value of matrix type IMAT 274* 275 DO 170 IMAT = 1, NIMAT 276* 277* Do the tests only if DOTYPE( IMAT ) is true. 278* 279 IF( .NOT.DOTYPE( IMAT ) ) 280 $ GO TO 170 281* 282* Skip types 3, 4, 5, or 6 if the matrix size is too small. 283* 284 ZEROT = IMAT.GE.3 .AND. IMAT.LE.6 285 IF( ZEROT .AND. N.LT.IMAT-2 ) 286 $ GO TO 170 287* 288* Do first for UPLO = 'U', then for UPLO = 'L' 289* 290 DO 160 IUPLO = 1, 2 291 UPLO = UPLOS( IUPLO ) 292* 293* Begin generate the test matrix A. 294* 295* Set up parameters with SLATB4 for the matrix generator 296* based on the type of matrix to be generated. 297* 298 CALL SLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE, 299 $ CNDNUM, DIST ) 300* 301* Generate a matrix with SLATMS. 302* 303 SRNAMT = 'SLATMS' 304 CALL SLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, 305 $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK, 306 $ INFO ) 307* 308* Check error code from SLATMS and handle error. 309* 310 IF( INFO.NE.0 ) THEN 311 CALL ALAERH( PATH, 'SLATMS', INFO, 0, UPLO, N, N, -1, 312 $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) 313* 314* Skip all tests for this generated matrix 315* 316 GO TO 160 317 END IF 318* 319* For matrix types 3-6, zero one or more rows and 320* columns of the matrix to test that INFO is returned 321* correctly. 322* 323 IF( ZEROT ) THEN 324 IF( IMAT.EQ.3 ) THEN 325 IZERO = 1 326 ELSE IF( IMAT.EQ.4 ) THEN 327 IZERO = N 328 ELSE 329 IZERO = N / 2 + 1 330 END IF 331* 332 IF( IMAT.LT.6 ) THEN 333* 334* Set row and column IZERO to zero. 335* 336 IF( IUPLO.EQ.1 ) THEN 337 IOFF = ( IZERO-1 )*LDA 338 DO 20 I = 1, IZERO - 1 339 A( IOFF+I ) = ZERO 340 20 CONTINUE 341 IOFF = IOFF + IZERO 342 DO 30 I = IZERO, N 343 A( IOFF ) = ZERO 344 IOFF = IOFF + LDA 345 30 CONTINUE 346 ELSE 347 IOFF = IZERO 348 DO 40 I = 1, IZERO - 1 349 A( IOFF ) = ZERO 350 IOFF = IOFF + LDA 351 40 CONTINUE 352 IOFF = IOFF - IZERO 353 DO 50 I = IZERO, N 354 A( IOFF+I ) = ZERO 355 50 CONTINUE 356 END IF 357 ELSE 358 IF( IUPLO.EQ.1 ) THEN 359* 360* Set the first IZERO rows and columns to zero. 361* 362 IOFF = 0 363 DO 70 J = 1, N 364 I2 = MIN( J, IZERO ) 365 DO 60 I = 1, I2 366 A( IOFF+I ) = ZERO 367 60 CONTINUE 368 IOFF = IOFF + LDA 369 70 CONTINUE 370 ELSE 371* 372* Set the last IZERO rows and columns to zero. 373* 374 IOFF = 0 375 DO 90 J = 1, N 376 I1 = MAX( J, IZERO ) 377 DO 80 I = I1, N 378 A( IOFF+I ) = ZERO 379 80 CONTINUE 380 IOFF = IOFF + LDA 381 90 CONTINUE 382 END IF 383 END IF 384 ELSE 385 IZERO = 0 386 END IF 387* 388* End generate the test matrix A. 389* 390* 391* Do for each value of NB in NBVAL 392* 393 DO 150 INB = 1, NNB 394* 395* Set the optimal blocksize, which will be later 396* returned by ILAENV. 397* 398 NB = NBVAL( INB ) 399 CALL XLAENV( 1, NB ) 400* 401* Copy the test matrix A into matrix AFAC which 402* will be factorized in place. This is needed to 403* preserve the test matrix A for subsequent tests. 404* 405 CALL SLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) 406* 407* Compute the L*D*L**T or U*D*U**T factorization of the 408* matrix. IWORK stores details of the interchanges and 409* the block structure of D. AINV is a work array for 410* block factorization, LWORK is the length of AINV. 411* 412 LWORK = MAX( 2, NB )*LDA 413 SRNAMT = 'SSYTRF' 414 CALL SSYTRF( UPLO, N, AFAC, LDA, IWORK, AINV, LWORK, 415 $ INFO ) 416* 417* Adjust the expected value of INFO to account for 418* pivoting. 419* 420 K = IZERO 421 IF( K.GT.0 ) THEN 422 100 CONTINUE 423 IF( IWORK( K ).LT.0 ) THEN 424 IF( IWORK( K ).NE.-K ) THEN 425 K = -IWORK( K ) 426 GO TO 100 427 END IF 428 ELSE IF( IWORK( K ).NE.K ) THEN 429 K = IWORK( K ) 430 GO TO 100 431 END IF 432 END IF 433* 434* Check error code from SSYTRF and handle error. 435* 436 IF( INFO.NE.K ) 437 $ CALL ALAERH( PATH, 'SSYTRF', INFO, K, UPLO, N, N, 438 $ -1, -1, NB, IMAT, NFAIL, NERRS, NOUT ) 439* 440* Set the condition estimate flag if the INFO is not 0. 441* 442 IF( INFO.NE.0 ) THEN 443 TRFCON = .TRUE. 444 ELSE 445 TRFCON = .FALSE. 446 END IF 447* 448*+ TEST 1 449* Reconstruct matrix from factors and compute residual. 450* 451 CALL SSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK, AINV, 452 $ LDA, RWORK, RESULT( 1 ) ) 453 NT = 1 454* 455*+ TEST 2 456* Form the inverse and compute the residual, 457* if the factorization was competed without INFO > 0 458* (i.e. there is no zero rows and columns). 459* Do it only for the first block size. 460* 461 IF( INB.EQ.1 .AND. .NOT.TRFCON ) THEN 462 CALL SLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA ) 463 SRNAMT = 'SSYTRI2' 464 LWORK = (N+NB+1)*(NB+3) 465 CALL SSYTRI2( UPLO, N, AINV, LDA, IWORK, WORK, 466 $ LWORK, INFO ) 467* 468* Check error code from SSYTRI2 and handle error. 469* 470 IF( INFO.NE.0 ) 471 $ CALL ALAERH( PATH, 'SSYTRI2', INFO, -1, UPLO, N, 472 $ N, -1, -1, -1, IMAT, NFAIL, NERRS, 473 $ NOUT ) 474* 475* Compute the residual for a symmetric matrix times 476* its inverse. 477* 478 CALL SPOT03( UPLO, N, A, LDA, AINV, LDA, WORK, LDA, 479 $ RWORK, RCONDC, RESULT( 2 ) ) 480 NT = 2 481 END IF 482* 483* Print information about the tests that did not pass 484* the threshold. 485* 486 DO 110 K = 1, NT 487 IF( RESULT( K ).GE.THRESH ) THEN 488 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 489 $ CALL ALAHD( NOUT, PATH ) 490 WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K, 491 $ RESULT( K ) 492 NFAIL = NFAIL + 1 493 END IF 494 110 CONTINUE 495 NRUN = NRUN + NT 496* 497* Skip the other tests if this is not the first block 498* size. 499* 500 IF( INB.GT.1 ) 501 $ GO TO 150 502* 503* Do only the condition estimate if INFO is not 0. 504* 505 IF( TRFCON ) THEN 506 RCONDC = ZERO 507 GO TO 140 508 END IF 509* 510* Do for each value of NRHS in NSVAL. 511* 512 DO 130 IRHS = 1, NNS 513 NRHS = NSVAL( IRHS ) 514* 515*+ TEST 3 (Using DSYTRS) 516* Solve and compute residual for A * X = B. 517* 518* Choose a set of NRHS random solution vectors 519* stored in XACT and set up the right hand side B 520* 521 SRNAMT = 'SLARHS' 522 CALL SLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU, 523 $ NRHS, A, LDA, XACT, LDA, B, LDA, 524 $ ISEED, INFO ) 525 CALL SLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) 526* 527 SRNAMT = 'SSYTRS' 528 CALL SSYTRS( UPLO, N, NRHS, AFAC, LDA, IWORK, X, 529 $ LDA, INFO ) 530* 531* Check error code from SSYTRS and handle error. 532* 533 IF( INFO.NE.0 ) 534 $ CALL ALAERH( PATH, 'SSYTRS', INFO, 0, UPLO, N, 535 $ N, -1, -1, NRHS, IMAT, NFAIL, 536 $ NERRS, NOUT ) 537* 538 CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) 539* 540* Compute the residual for the solution 541* 542 CALL SPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, 543 $ LDA, RWORK, RESULT( 3 ) ) 544* 545*+ TEST 4 (Using DSYTRS2) 546* Solve and compute residual for A * X = B. 547* 548* Choose a set of NRHS random solution vectors 549* stored in XACT and set up the right hand side B 550* 551 SRNAMT = 'SLARHS' 552 CALL SLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU, 553 $ NRHS, A, LDA, XACT, LDA, B, LDA, 554 $ ISEED, INFO ) 555 CALL SLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) 556* 557 SRNAMT = 'DSYTRS2' 558 CALL SSYTRS2( UPLO, N, NRHS, AFAC, LDA, IWORK, X, 559 $ LDA, WORK, INFO ) 560* 561* Check error code from SSYTRS2 and handle error. 562* 563 IF( INFO.NE.0 ) 564 $ CALL ALAERH( PATH, 'SSYTRS2', INFO, 0, UPLO, N, 565 $ N, -1, -1, NRHS, IMAT, NFAIL, 566 $ NERRS, NOUT ) 567* 568 CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) 569* 570* Compute the residual for the solution 571* 572 CALL SPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, 573 $ LDA, RWORK, RESULT( 4 ) ) 574* 575*+ TEST 5 576* Check solution from generated exact solution. 577* 578 CALL SGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 579 $ RESULT( 5 ) ) 580* 581*+ TESTS 6, 7, and 8 582* Use iterative refinement to improve the solution. 583* 584 SRNAMT = 'SSYRFS' 585 CALL SSYRFS( UPLO, N, NRHS, A, LDA, AFAC, LDA, 586 $ IWORK, B, LDA, X, LDA, RWORK, 587 $ RWORK( NRHS+1 ), WORK, IWORK( N+1 ), 588 $ INFO ) 589* 590* Check error code from SSYRFS and handle error. 591* 592 IF( INFO.NE.0 ) 593 $ CALL ALAERH( PATH, 'SSYRFS', INFO, 0, UPLO, N, 594 $ N, -1, -1, NRHS, IMAT, NFAIL, 595 $ NERRS, NOUT ) 596* 597 CALL SGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 598 $ RESULT( 6 ) ) 599 CALL SPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA, 600 $ XACT, LDA, RWORK, RWORK( NRHS+1 ), 601 $ RESULT( 7 ) ) 602* 603* Print information about the tests that did not pass 604* the threshold. 605* 606 DO 120 K = 3, 8 607 IF( RESULT( K ).GE.THRESH ) THEN 608 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 609 $ CALL ALAHD( NOUT, PATH ) 610 WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS, 611 $ IMAT, K, RESULT( K ) 612 NFAIL = NFAIL + 1 613 END IF 614 120 CONTINUE 615 NRUN = NRUN + 6 616* 617* End do for each value of NRHS in NSVAL. 618* 619 130 CONTINUE 620* 621*+ TEST 9 622* Get an estimate of RCOND = 1/CNDNUM. 623* 624 140 CONTINUE 625 ANORM = SLANSY( '1', UPLO, N, A, LDA, RWORK ) 626 SRNAMT = 'SSYCON' 627 CALL SSYCON( UPLO, N, AFAC, LDA, IWORK, ANORM, RCOND, 628 $ WORK, IWORK( N+1 ), INFO ) 629* 630* Check error code from SSYCON and handle error. 631* 632 IF( INFO.NE.0 ) 633 $ CALL ALAERH( PATH, 'SSYCON', INFO, 0, UPLO, N, N, 634 $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT ) 635* 636* Compute the test ratio to compare to values of RCOND 637* 638 RESULT( 9 ) = SGET06( RCOND, RCONDC ) 639* 640* Print information about the tests that did not pass 641* the threshold. 642* 643 IF( RESULT( 9 ).GE.THRESH ) THEN 644 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 645 $ CALL ALAHD( NOUT, PATH ) 646 WRITE( NOUT, FMT = 9997 )UPLO, N, IMAT, 9, 647 $ RESULT( 9 ) 648 NFAIL = NFAIL + 1 649 END IF 650 NRUN = NRUN + 1 651 150 CONTINUE 652* 653 160 CONTINUE 654 170 CONTINUE 655 180 CONTINUE 656* 657* Print a summary of the results. 658* 659 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) 660* 661 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ', 662 $ I2, ', test ', I2, ', ratio =', G12.5 ) 663 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ', 664 $ I2, ', test(', I2, ') =', G12.5 ) 665 9997 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ',', 10X, ' type ', I2, 666 $ ', test(', I2, ') =', G12.5 ) 667 RETURN 668* 669* End of SCHKSY 670* 671 END 672