1*> \brief \b SCHKSY_AA 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_AA( 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_AA tests SSYTRF_AA, -TRS_AA. 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 real_lin 165* 166* ===================================================================== 167 SUBROUTINE SCHKSY_AA( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, 168 $ THRESH, TSTERR, NMAX, A, AFAC, AINV, B, 169 $ X, 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 IMPLICIT NONE 176* 177* .. Scalar Arguments .. 178 LOGICAL TSTERR 179 INTEGER NN, NNB, NNS, NMAX, NOUT 180 REAL THRESH 181* .. 182* .. Array Arguments .. 183 LOGICAL DOTYPE( * ) 184 INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * ) 185 REAL A( * ), AFAC( * ), AINV( * ), B( * ), 186 $ RWORK( * ), WORK( * ), X( * ), XACT( * ) 187* .. 188* 189* ===================================================================== 190* 191* .. Parameters .. 192 REAL ZERO 193 PARAMETER ( ZERO = 0.0E+0 ) 194 INTEGER NTYPES 195 PARAMETER ( NTYPES = 10 ) 196 INTEGER NTESTS 197 PARAMETER ( NTESTS = 9 ) 198* .. 199* .. Local Scalars .. 200 LOGICAL ZEROT 201 CHARACTER DIST, TYPE, UPLO, XTYPE 202 CHARACTER*3 PATH, MATPATH 203 INTEGER I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS, 204 $ IUPLO, IZERO, J, K, KL, KU, LDA, LWORK, MODE, 205 $ N, NB, NERRS, NFAIL, NIMAT, NRHS, NRUN, NT 206 REAL ANORM, CNDNUM 207* .. 208* .. Local Arrays .. 209 CHARACTER UPLOS( 2 ) 210 INTEGER ISEED( 4 ), ISEEDY( 4 ) 211 REAL RESULT( NTESTS ) 212* .. 213* .. External Subroutines .. 214 EXTERNAL ALAERH, ALAHD, ALASUM, SERRSY, SLACPY, SLARHS, 215 $ SLATB4, SLATMS, SPOT02, SSYT01_AA, SSYTRF_AA, 216 $ SSYTRS_AA, XLAENV 217* .. 218* .. Intrinsic Functions .. 219 INTRINSIC MAX, MIN 220* .. 221* .. Scalars in Common .. 222 LOGICAL LERR, OK 223 CHARACTER*32 SRNAMT 224 INTEGER INFOT, NUNIT 225* .. 226* .. Common blocks .. 227 COMMON / INFOC / INFOT, NUNIT, OK, LERR 228 COMMON / SRNAMC / SRNAMT 229* .. 230* .. Data statements .. 231 DATA ISEEDY / 1988, 1989, 1990, 1991 / 232 DATA UPLOS / 'U', 'L' / 233* .. 234* .. Executable Statements .. 235* 236* Initialize constants and the random number seed. 237* 238* 239* Test path 240* 241 PATH( 1: 1 ) = 'Single precision' 242 PATH( 2: 3 ) = 'SA' 243* 244* Path to generate matrices 245* 246 MATPATH( 1: 1 ) = 'Single precision' 247 MATPATH( 2: 3 ) = 'SY' 248 NRUN = 0 249 NFAIL = 0 250 NERRS = 0 251 DO 10 I = 1, 4 252 ISEED( I ) = ISEEDY( I ) 253 10 CONTINUE 254* 255* Test the error exits 256* 257 IF( TSTERR ) 258 $ CALL SERRSY( PATH, NOUT ) 259 INFOT = 0 260* 261* Set the minimum block size for which the block routine should 262* be used, which will be later returned by ILAENV 263* 264 CALL XLAENV( 2, 2 ) 265* 266* Do for each value of N in NVAL 267* 268 DO 180 IN = 1, NN 269 N = NVAL( IN ) 270 IF( N .GT. NMAX ) THEN 271 NFAIL = NFAIL + 1 272 WRITE(NOUT, 9995) 'M ', N, NMAX 273 GO TO 180 274 END IF 275 LDA = MAX( N, 1 ) 276 XTYPE = 'N' 277 NIMAT = NTYPES 278 IF( N.LE.0 ) 279 $ NIMAT = 1 280* 281 IZERO = 0 282* 283* Do for each value of matrix type IMAT 284* 285 DO 170 IMAT = 1, NIMAT 286* 287* Do the tests only if DOTYPE( IMAT ) is true. 288* 289 IF( .NOT.DOTYPE( IMAT ) ) 290 $ GO TO 170 291* 292* Skip types 3, 4, 5, or 6 if the matrix size is too small. 293* 294 ZEROT = IMAT.GE.3 .AND. IMAT.LE.6 295 IF( ZEROT .AND. N.LT.IMAT-2 ) 296 $ GO TO 170 297* 298* Do first for UPLO = 'U', then for UPLO = 'L' 299* 300 DO 160 IUPLO = 1, 2 301 UPLO = UPLOS( IUPLO ) 302* 303* Begin generate the test matrix A. 304* 305* 306* Set up parameters with SLATB4 for the matrix generator 307* based on the type of matrix to be generated. 308* 309 CALL SLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU, 310 $ ANORM, MODE, CNDNUM, DIST ) 311* 312* Generate a matrix with SLATMS. 313* 314 SRNAMT = 'SLATMS' 315 CALL SLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, 316 $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK, 317 $ INFO ) 318* 319* Check error code from SLATMS and handle error. 320* 321 IF( INFO.NE.0 ) THEN 322 CALL ALAERH( PATH, 'SLATMS', INFO, 0, UPLO, N, N, -1, 323 $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) 324* 325* Skip all tests for this generated matrix 326* 327 GO TO 160 328 END IF 329* 330* For matrix types 3-6, zero one or more rows and 331* columns of the matrix to test that INFO is returned 332* correctly. 333* 334 IF( ZEROT ) THEN 335 IF( IMAT.EQ.3 ) THEN 336 IZERO = 1 337 ELSE IF( IMAT.EQ.4 ) THEN 338 IZERO = N 339 ELSE 340 IZERO = N / 2 + 1 341 END IF 342* 343 IF( IMAT.LT.6 ) THEN 344* 345* Set row and column IZERO to zero. 346* 347 IF( IUPLO.EQ.1 ) THEN 348 IOFF = ( IZERO-1 )*LDA 349 DO 20 I = 1, IZERO - 1 350 A( IOFF+I ) = ZERO 351 20 CONTINUE 352 IOFF = IOFF + IZERO 353 DO 30 I = IZERO, N 354 A( IOFF ) = ZERO 355 IOFF = IOFF + LDA 356 30 CONTINUE 357 ELSE 358 IOFF = IZERO 359 DO 40 I = 1, IZERO - 1 360 A( IOFF ) = ZERO 361 IOFF = IOFF + LDA 362 40 CONTINUE 363 IOFF = IOFF - IZERO 364 DO 50 I = IZERO, N 365 A( IOFF+I ) = ZERO 366 50 CONTINUE 367 END IF 368 ELSE 369 IF( IUPLO.EQ.1 ) THEN 370* 371* Set the first IZERO rows and columns to zero. 372* 373 IOFF = 0 374 DO 70 J = 1, N 375 I2 = MIN( J, IZERO ) 376 DO 60 I = 1, I2 377 A( IOFF+I ) = ZERO 378 60 CONTINUE 379 IOFF = IOFF + LDA 380 70 CONTINUE 381 IZERO = 1 382 ELSE 383* 384* Set the last IZERO rows and columns to zero. 385* 386 IOFF = 0 387 DO 90 J = 1, N 388 I1 = MAX( J, IZERO ) 389 DO 80 I = I1, N 390 A( IOFF+I ) = ZERO 391 80 CONTINUE 392 IOFF = IOFF + LDA 393 90 CONTINUE 394 END IF 395 END IF 396 ELSE 397 IZERO = 0 398 END IF 399* 400* End generate the test matrix A. 401* 402* Do for each value of NB in NBVAL 403* 404 DO 150 INB = 1, NNB 405* 406* Set the optimal blocksize, which will be later 407* returned by ILAENV. 408* 409 NB = NBVAL( INB ) 410 CALL XLAENV( 1, NB ) 411* 412* Copy the test matrix A into matrix AFAC which 413* will be factorized in place. This is needed to 414* preserve the test matrix A for subsequent tests. 415* 416 CALL SLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) 417* 418* Compute the L*D*L**T or U*D*U**T factorization of the 419* matrix. IWORK stores details of the interchanges and 420* the block structure of D. AINV is a work array for 421* block factorization, LWORK is the length of AINV. 422* 423 SRNAMT = 'SSYTRF_AA' 424 LWORK = MAX( 1, N*NB + N ) 425 CALL SSYTRF_AA( UPLO, N, AFAC, LDA, IWORK, AINV, 426 $ LWORK, INFO ) 427* 428* Adjust the expected value of INFO to account for 429* pivoting. 430* 431c IF( IZERO.GT.0 ) THEN 432c J = 1 433c K = IZERO 434c 100 CONTINUE 435c IF( J.EQ.K ) THEN 436c K = IWORK( J ) 437c ELSE IF( IWORK( J ).EQ.K ) THEN 438c K = J 439c END IF 440c IF( J.LT.K ) THEN 441c J = J + 1 442c GO TO 100 443c END IF 444c ELSE 445 K = 0 446c END IF 447* 448* Check error code from SSYTRF and handle error. 449* 450 IF( INFO.NE.K ) THEN 451 CALL ALAERH( PATH, 'SSYTRF_AA', INFO, K, UPLO, 452 $ N, N, -1, -1, NB, IMAT, NFAIL, NERRS, 453 $ NOUT ) 454 END IF 455* 456*+ TEST 1 457* Reconstruct matrix from factors and compute residual. 458* 459 CALL SSYT01_AA( UPLO, N, A, LDA, AFAC, LDA, IWORK, 460 $ AINV, LDA, RWORK, RESULT( 1 ) ) 461 NT = 1 462* 463* 464* Print information about the tests that did not pass 465* the threshold. 466* 467 DO 110 K = 1, NT 468 IF( RESULT( K ).GE.THRESH ) THEN 469 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 470 $ CALL ALAHD( NOUT, PATH ) 471 WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K, 472 $ RESULT( K ) 473 NFAIL = NFAIL + 1 474 END IF 475 110 CONTINUE 476 NRUN = NRUN + NT 477* 478* Skip solver test if INFO is not 0. 479* 480 IF( INFO.NE.0 ) THEN 481 GO TO 140 482 END IF 483* 484* Do for each value of NRHS in NSVAL. 485* 486 DO 130 IRHS = 1, NNS 487 NRHS = NSVAL( IRHS ) 488* 489*+ TEST 2 (Using TRS) 490* Solve and compute residual for A * X = B. 491* 492* Choose a set of NRHS random solution vectors 493* stored in XACT and set up the right hand side B 494* 495 SRNAMT = 'SLARHS' 496 CALL SLARHS( MATPATH, XTYPE, UPLO, ' ', N, N, 497 $ KL, KU, NRHS, A, LDA, XACT, LDA, 498 $ B, LDA, ISEED, INFO ) 499 CALL SLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) 500* 501 SRNAMT = 'SSYTRS_AA' 502 LWORK = MAX( 1, 3*N-2 ) 503 CALL SSYTRS_AA( UPLO, N, NRHS, AFAC, LDA, 504 $ IWORK, X, LDA, WORK, LWORK, 505 $ INFO ) 506* 507* Check error code from SSYTRS and handle error. 508* 509 IF( INFO.NE.0 ) THEN 510 IF( IZERO.EQ.0 ) THEN 511 CALL ALAERH( PATH, 'SSYTRS_AA', INFO, 0, 512 $ UPLO, N, N, -1, -1, NRHS, IMAT, 513 $ NFAIL, NERRS, NOUT ) 514 END IF 515 ELSE 516 CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA 517 $ ) 518* 519* Compute the residual for the solution 520* 521 CALL SPOT02( UPLO, N, NRHS, A, LDA, X, LDA, 522 $ WORK, LDA, RWORK, RESULT( 2 ) ) 523* 524* 525* Print information about the tests that did not pass 526* the threshold. 527* 528 DO 120 K = 2, 2 529 IF( RESULT( K ).GE.THRESH ) THEN 530 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 531 $ CALL ALAHD( NOUT, PATH ) 532 WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS, 533 $ IMAT, K, RESULT( K ) 534 NFAIL = NFAIL + 1 535 END IF 536 120 CONTINUE 537 END IF 538 NRUN = NRUN + 1 539* 540* End do for each value of NRHS in NSVAL. 541* 542 130 CONTINUE 543 140 CONTINUE 544 150 CONTINUE 545 160 CONTINUE 546 170 CONTINUE 547 180 CONTINUE 548* 549* Print a summary of the results. 550* 551 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) 552* 553 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ', 554 $ I2, ', test ', I2, ', ratio =', G12.5 ) 555 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ', 556 $ I2, ', test(', I2, ') =', G12.5 ) 557 9995 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be <=', 558 $ I6 ) 559 RETURN 560* 561* End of SCHKSY_AA 562* 563 END 564