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