1*> \brief \b ZCHKHE_RK 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 ZCHKHE_RK( 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* DOUBLE PRECISION THRESH 19* .. 20* .. Array Arguments .. 21* LOGICAL DOTYPE( * ) 22* INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * ) 23* DOUBLE PRECISION RWORK( * ) 24* COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ), E( * ), 25* $ WORK( * ), X( * ), XACT( * ) 26* .. 27* 28* 29*> \par Purpose: 30* ============= 31*> 32*> \verbatim 33*> 34*> ZCHKHE_RK tests ZHETRF_RK, -TRI_3, -TRS_3, 35*> and -CON_3. 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 CCOMPLEX*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] E 117*> \verbatim 118*> E is COMPLEX*16 array, dimension (NMAX) 119*> \endverbatim 120*> 121*> \param[out] AINV 122*> \verbatim 123*> AINV is COMPLEX*16 array, dimension (NMAX*NMAX) 124*> \endverbatim 125*> 126*> \param[out] B 127*> \verbatim 128*> B is CCOMPLEX*16 array, dimension (NMAX*NSMAX) 129*> where NSMAX is the largest entry in NSVAL. 130*> \endverbatim 131*> 132*> \param[out] X 133*> \verbatim 134*> X is COMPLEX*16 array, dimension (NMAX*NSMAX) 135*> \endverbatim 136*> 137*> \param[out] XACT 138*> \verbatim 139*> XACT is COMPLEX*16 array, dimension (NMAX*NSMAX) 140*> \endverbatim 141*> 142*> \param[out] WORK 143*> \verbatim 144*> WORK is COMPLEX*16 array, dimension (NMAX*max(3,NSMAX)) 145*> \endverbatim 146*> 147*> \param[out] RWORK 148*> \verbatim 149*> RWORK is DOUBLE PRECISION array, dimension (max(NMAX,2*NSMAX) 150*> \endverbatim 151*> 152*> \param[out] IWORK 153*> \verbatim 154*> IWORK is INTEGER array, dimension (2*NMAX) 155*> \endverbatim 156*> 157*> \param[in] NOUT 158*> \verbatim 159*> NOUT is INTEGER 160*> The unit number for output. 161*> \endverbatim 162* 163* Authors: 164* ======== 165* 166*> \author Univ. of Tennessee 167*> \author Univ. of California Berkeley 168*> \author Univ. of Colorado Denver 169*> \author NAG Ltd. 170* 171*> \date December 2016 172* 173*> \ingroup complex16_lin 174* 175* ===================================================================== 176 SUBROUTINE ZCHKHE_RK( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, 177 $ THRESH, TSTERR, NMAX, A, AFAC, E, AINV, B, 178 $ X, XACT, WORK, RWORK, IWORK, NOUT ) 179* 180* -- LAPACK test routine (version 3.7.0) -- 181* -- LAPACK is a software package provided by Univ. of Tennessee, -- 182* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 183* December 2016 184* 185* .. Scalar Arguments .. 186 LOGICAL TSTERR 187 INTEGER NMAX, NN, NNB, NNS, NOUT 188 DOUBLE PRECISION THRESH 189* .. 190* .. Array Arguments .. 191 LOGICAL DOTYPE( * ) 192 INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * ) 193 DOUBLE PRECISION RWORK( * ) 194 COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ), E( * ), 195 $ WORK( * ), X( * ), XACT( * ) 196* .. 197* 198* ===================================================================== 199* 200* .. Parameters .. 201 DOUBLE PRECISION ZERO, ONE 202 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) 203 DOUBLE PRECISION ONEHALF 204 PARAMETER ( ONEHALF = 0.5D+0 ) 205 DOUBLE PRECISION EIGHT, SEVTEN 206 PARAMETER ( EIGHT = 8.0D+0, SEVTEN = 17.0D+0 ) 207 COMPLEX*16 CZERO 208 PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ) ) 209 INTEGER NTYPES 210 PARAMETER ( NTYPES = 10 ) 211 INTEGER NTESTS 212 PARAMETER ( NTESTS = 7 ) 213* .. 214* .. Local Scalars .. 215 LOGICAL TRFCON, ZEROT 216 CHARACTER DIST, TYPE, UPLO, XTYPE 217 CHARACTER*3 PATH, MATPATH 218 INTEGER I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS, 219 $ ITEMP, ITEMP2, IUPLO, IZERO, J, K, KL, KU, LDA, 220 $ LWORK, MODE, N, NB, NERRS, NFAIL, NIMAT, NRHS, 221 $ NRUN, NT 222 DOUBLE PRECISION ALPHA, ANORM, CNDNUM, CONST, SING_MAX, 223 $ SING_MIN, RCOND, RCONDC, DTEMP 224* .. 225* .. Local Arrays .. 226 CHARACTER UPLOS( 2 ) 227 INTEGER ISEED( 4 ), ISEEDY( 4 ), IDUMMY( 1 ) 228 DOUBLE PRECISION RESULT( NTESTS ) 229 COMPLEX*16 BLOCK( 2, 2 ), ZDUMMY( 1 ) 230* .. 231* .. External Functions .. 232 DOUBLE PRECISION DGET06, ZLANGE, ZLANHE 233 EXTERNAL DGET06, ZLANGE, ZLANHE 234* .. 235* .. External Subroutines .. 236 EXTERNAL ALAERH, ALAHD, ALASUM, ZERRHE, ZGESVD, ZGET04, 237 $ ZLACPY, ZLARHS, ZLATB4, ZLATMS, ZPOT02, ZPOT03, 238 $ ZHECON_3, ZHET01_3, ZHETRF_RK, ZHETRI_3, 239 $ ZHETRS_3, XLAENV 240* .. 241* .. Intrinsic Functions .. 242 INTRINSIC DCONJG, MAX, MIN, SQRT 243* .. 244* .. Scalars in Common .. 245 LOGICAL LERR, OK 246 CHARACTER*32 SRNAMT 247 INTEGER INFOT, NUNIT 248* .. 249* .. Common blocks .. 250 COMMON / INFOC / INFOT, NUNIT, OK, LERR 251 COMMON / SRNAMC / SRNAMT 252* .. 253* .. Data statements .. 254 DATA ISEEDY / 1988, 1989, 1990, 1991 / 255 DATA UPLOS / 'U', 'L' / 256* .. 257* .. Executable Statements .. 258* 259* Initialize constants and the random number seed. 260* 261 ALPHA = ( ONE+SQRT( SEVTEN ) ) / EIGHT 262* 263* Test path 264* 265 PATH( 1: 1 ) = 'Zomplex precision' 266 PATH( 2: 3 ) = 'HK' 267* 268* Path to generate matrices 269* 270 MATPATH( 1: 1 ) = 'Zomplex precision' 271 MATPATH( 2: 3 ) = 'HE' 272* 273 NRUN = 0 274 NFAIL = 0 275 NERRS = 0 276 DO 10 I = 1, 4 277 ISEED( I ) = ISEEDY( I ) 278 10 CONTINUE 279* 280* Test the error exits 281* 282 IF( TSTERR ) 283 $ CALL ZERRHE( PATH, NOUT ) 284 INFOT = 0 285* 286* Set the minimum block size for which the block routine should 287* be used, which will be later returned by ILAENV 288* 289 CALL XLAENV( 2, 2 ) 290* 291* Do for each value of N in NVAL 292* 293 DO 270 IN = 1, NN 294 N = NVAL( IN ) 295 LDA = MAX( N, 1 ) 296 XTYPE = 'N' 297 NIMAT = NTYPES 298 IF( N.LE.0 ) 299 $ NIMAT = 1 300* 301 IZERO = 0 302* 303* Do for each value of matrix type IMAT 304* 305 DO 260 IMAT = 1, NIMAT 306* 307* Do the tests only if DOTYPE( IMAT ) is true. 308* 309 IF( .NOT.DOTYPE( IMAT ) ) 310 $ GO TO 260 311* 312* Skip types 3, 4, 5, or 6 if the matrix size is too small. 313* 314 ZEROT = IMAT.GE.3 .AND. IMAT.LE.6 315 IF( ZEROT .AND. N.LT.IMAT-2 ) 316 $ GO TO 260 317* 318* Do first for UPLO = 'U', then for UPLO = 'L' 319* 320 DO 250 IUPLO = 1, 2 321 UPLO = UPLOS( IUPLO ) 322* 323* Begin generate the test matrix A. 324* 325* Set up parameters with ZLATB4 for the matrix generator 326* based on the type of matrix to be generated. 327* 328 CALL ZLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU, ANORM, 329 $ MODE, CNDNUM, DIST ) 330* 331* Generate a matrix with ZLATMS. 332* 333 SRNAMT = 'ZLATMS' 334 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, 335 $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, 336 $ WORK, INFO ) 337* 338* Check error code from ZLATMS and handle error. 339* 340 IF( INFO.NE.0 ) THEN 341 CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N, 342 $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT ) 343* 344* Skip all tests for this generated matrix 345* 346 GO TO 250 347 END IF 348* 349* For matrix types 3-6, zero one or more rows and 350* columns of the matrix to test that INFO is returned 351* correctly. 352* 353 IF( ZEROT ) THEN 354 IF( IMAT.EQ.3 ) THEN 355 IZERO = 1 356 ELSE IF( IMAT.EQ.4 ) THEN 357 IZERO = N 358 ELSE 359 IZERO = N / 2 + 1 360 END IF 361* 362 IF( IMAT.LT.6 ) THEN 363* 364* Set row and column IZERO to zero. 365* 366 IF( IUPLO.EQ.1 ) THEN 367 IOFF = ( IZERO-1 )*LDA 368 DO 20 I = 1, IZERO - 1 369 A( IOFF+I ) = CZERO 370 20 CONTINUE 371 IOFF = IOFF + IZERO 372 DO 30 I = IZERO, N 373 A( IOFF ) = CZERO 374 IOFF = IOFF + LDA 375 30 CONTINUE 376 ELSE 377 IOFF = IZERO 378 DO 40 I = 1, IZERO - 1 379 A( IOFF ) = CZERO 380 IOFF = IOFF + LDA 381 40 CONTINUE 382 IOFF = IOFF - IZERO 383 DO 50 I = IZERO, N 384 A( IOFF+I ) = CZERO 385 50 CONTINUE 386 END IF 387 ELSE 388 IF( IUPLO.EQ.1 ) THEN 389* 390* Set the first IZERO rows and columns to zero. 391* 392 IOFF = 0 393 DO 70 J = 1, N 394 I2 = MIN( J, IZERO ) 395 DO 60 I = 1, I2 396 A( IOFF+I ) = CZERO 397 60 CONTINUE 398 IOFF = IOFF + LDA 399 70 CONTINUE 400 ELSE 401* 402* Set the last IZERO rows and columns to zero. 403* 404 IOFF = 0 405 DO 90 J = 1, N 406 I1 = MAX( J, IZERO ) 407 DO 80 I = I1, N 408 A( IOFF+I ) = CZERO 409 80 CONTINUE 410 IOFF = IOFF + LDA 411 90 CONTINUE 412 END IF 413 END IF 414 ELSE 415 IZERO = 0 416 END IF 417* 418* End generate the test matrix A. 419* 420* 421* Do for each value of NB in NBVAL 422* 423 DO 240 INB = 1, NNB 424* 425* Set the optimal blocksize, which will be later 426* returned by ILAENV. 427* 428 NB = NBVAL( INB ) 429 CALL XLAENV( 1, NB ) 430* 431* Copy the test matrix A into matrix AFAC which 432* will be factorized in place. This is needed to 433* preserve the test matrix A for subsequent tests. 434* 435 CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) 436* 437* Compute the L*D*L**T or U*D*U**T factorization of the 438* matrix. IWORK stores details of the interchanges and 439* the block structure of D. AINV is a work array for 440* block factorization, LWORK is the length of AINV. 441* 442 LWORK = MAX( 2, NB )*LDA 443 SRNAMT = 'ZHETRF_RK' 444 CALL ZHETRF_RK( UPLO, N, AFAC, LDA, E, IWORK, AINV, 445 $ LWORK, INFO ) 446* 447* Adjust the expected value of INFO to account for 448* pivoting. 449* 450 K = IZERO 451 IF( K.GT.0 ) THEN 452 100 CONTINUE 453 IF( IWORK( K ).LT.0 ) THEN 454 IF( IWORK( K ).NE.-K ) THEN 455 K = -IWORK( K ) 456 GO TO 100 457 END IF 458 ELSE IF( IWORK( K ).NE.K ) THEN 459 K = IWORK( K ) 460 GO TO 100 461 END IF 462 END IF 463* 464* Check error code from ZHETRF_RK and handle error. 465* 466 IF( INFO.NE.K) 467 $ CALL ALAERH( PATH, 'ZHETRF_RK', INFO, K, 468 $ UPLO, N, N, -1, -1, NB, IMAT, 469 $ NFAIL, NERRS, NOUT ) 470* 471* Set the condition estimate flag if the INFO is not 0. 472* 473 IF( INFO.NE.0 ) THEN 474 TRFCON = .TRUE. 475 ELSE 476 TRFCON = .FALSE. 477 END IF 478* 479*+ TEST 1 480* Reconstruct matrix from factors and compute residual. 481* 482 CALL ZHET01_3( UPLO, N, A, LDA, AFAC, LDA, E, IWORK, 483 $ AINV, LDA, RWORK, RESULT( 1 ) ) 484 NT = 1 485* 486*+ TEST 2 487* Form the inverse and compute the residual, 488* if the factorization was competed without INFO > 0 489* (i.e. there is no zero rows and columns). 490* Do it only for the first block size. 491* 492 IF( INB.EQ.1 .AND. .NOT.TRFCON ) THEN 493 CALL ZLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA ) 494 SRNAMT = 'ZHETRI_3' 495* 496* Another reason that we need to compute the invesrse 497* is that ZPOT03 produces RCONDC which is used later 498* in TEST6 and TEST7. 499* 500 LWORK = (N+NB+1)*(NB+3) 501 CALL ZHETRI_3( UPLO, N, AINV, LDA, E, IWORK, WORK, 502 $ LWORK, INFO ) 503* 504* Check error code from ZHETRI_3 and handle error. 505* 506 IF( INFO.NE.0 ) 507 $ CALL ALAERH( PATH, 'ZHETRI_3', INFO, -1, 508 $ UPLO, N, N, -1, -1, -1, IMAT, 509 $ NFAIL, NERRS, NOUT ) 510* 511* Compute the residual for a Hermitian matrix times 512* its inverse. 513* 514 CALL ZPOT03( UPLO, N, A, LDA, AINV, LDA, WORK, LDA, 515 $ RWORK, RCONDC, RESULT( 2 ) ) 516 NT = 2 517 END IF 518* 519* Print information about the tests that did not pass 520* the threshold. 521* 522 DO 110 K = 1, NT 523 IF( RESULT( K ).GE.THRESH ) THEN 524 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 525 $ CALL ALAHD( NOUT, PATH ) 526 WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K, 527 $ RESULT( K ) 528 NFAIL = NFAIL + 1 529 END IF 530 110 CONTINUE 531 NRUN = NRUN + NT 532* 533*+ TEST 3 534* Compute largest element in U or L 535* 536 RESULT( 3 ) = ZERO 537 DTEMP = ZERO 538* 539 CONST = ( ( ALPHA**2-ONE ) / ( ALPHA**2-ONEHALF ) ) / 540 $ ( ONE-ALPHA ) 541* 542 IF( IUPLO.EQ.1 ) THEN 543* 544* Compute largest element in U 545* 546 K = N 547 120 CONTINUE 548 IF( K.LE.1 ) 549 $ GO TO 130 550* 551 IF( IWORK( K ).GT.ZERO ) THEN 552* 553* Get max absolute value from elements 554* in column k in U 555* 556 DTEMP = ZLANGE( 'M', K-1, 1, 557 $ AFAC( ( K-1 )*LDA+1 ), LDA, RWORK ) 558 ELSE 559* 560* Get max absolute value from elements 561* in columns k and k-1 in U 562* 563 DTEMP = ZLANGE( 'M', K-2, 2, 564 $ AFAC( ( K-2 )*LDA+1 ), LDA, RWORK ) 565 K = K - 1 566* 567 END IF 568* 569* DTEMP should be bounded by CONST 570* 571 DTEMP = DTEMP - CONST + THRESH 572 IF( DTEMP.GT.RESULT( 3 ) ) 573 $ RESULT( 3 ) = DTEMP 574* 575 K = K - 1 576* 577 GO TO 120 578 130 CONTINUE 579* 580 ELSE 581* 582* Compute largest element in L 583* 584 K = 1 585 140 CONTINUE 586 IF( K.GE.N ) 587 $ GO TO 150 588* 589 IF( IWORK( K ).GT.ZERO ) THEN 590* 591* Get max absolute value from elements 592* in column k in L 593* 594 DTEMP = ZLANGE( 'M', N-K, 1, 595 $ AFAC( ( K-1 )*LDA+K+1 ), LDA, RWORK ) 596 ELSE 597* 598* Get max absolute value from elements 599* in columns k and k+1 in L 600* 601 DTEMP = ZLANGE( 'M', N-K-1, 2, 602 $ AFAC( ( K-1 )*LDA+K+2 ), LDA, RWORK ) 603 K = K + 1 604* 605 END IF 606* 607* DTEMP should be bounded by CONST 608* 609 DTEMP = DTEMP - CONST + THRESH 610 IF( DTEMP.GT.RESULT( 3 ) ) 611 $ RESULT( 3 ) = DTEMP 612* 613 K = K + 1 614* 615 GO TO 140 616 150 CONTINUE 617 END IF 618* 619* 620*+ TEST 4 621* Compute largest 2-Norm (condition number) 622* of 2-by-2 diag blocks 623* 624 RESULT( 4 ) = ZERO 625 DTEMP = ZERO 626* 627 CONST = ( ( ALPHA**2-ONE ) / ( ALPHA**2-ONEHALF ) )* 628 $ ( ( ONE + ALPHA ) / ( ONE - ALPHA ) ) 629 CALL ZLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA ) 630* 631 IF( IUPLO.EQ.1 ) THEN 632* 633* Loop backward for UPLO = 'U' 634* 635 K = N 636 160 CONTINUE 637 IF( K.LE.1 ) 638 $ GO TO 170 639* 640 IF( IWORK( K ).LT.ZERO ) THEN 641* 642* Get the two singular values 643* (real and non-negative) of a 2-by-2 block, 644* store them in RWORK array 645* 646 BLOCK( 1, 1 ) = AFAC( ( K-2 )*LDA+K-1 ) 647 BLOCK( 1, 2 ) = E( K ) 648 BLOCK( 2, 1 ) = DCONJG( BLOCK( 1, 2 ) ) 649 BLOCK( 2, 2 ) = AFAC( (K-1)*LDA+K ) 650* 651 CALL ZGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK, 652 $ ZDUMMY, 1, ZDUMMY, 1, 653 $ WORK, 6, RWORK( 3 ), INFO ) 654* 655* 656 SING_MAX = RWORK( 1 ) 657 SING_MIN = RWORK( 2 ) 658* 659 DTEMP = SING_MAX / SING_MIN 660* 661* DTEMP should be bounded by CONST 662* 663 DTEMP = DTEMP - CONST + THRESH 664 IF( DTEMP.GT.RESULT( 4 ) ) 665 $ RESULT( 4 ) = DTEMP 666 K = K - 1 667* 668 END IF 669* 670 K = K - 1 671* 672 GO TO 160 673 170 CONTINUE 674* 675 ELSE 676* 677* Loop forward for UPLO = 'L' 678* 679 K = 1 680 180 CONTINUE 681 IF( K.GE.N ) 682 $ GO TO 190 683* 684 IF( IWORK( K ).LT.ZERO ) THEN 685* 686* Get the two singular values 687* (real and non-negative) of a 2-by-2 block, 688* store them in RWORK array 689* 690 BLOCK( 1, 1 ) = AFAC( ( K-1 )*LDA+K ) 691 BLOCK( 2, 1 ) = E( K ) 692 BLOCK( 1, 2 ) = DCONJG( BLOCK( 2, 1 ) ) 693 BLOCK( 2, 2 ) = AFAC( K*LDA+K+1 ) 694* 695 CALL ZGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK, 696 $ ZDUMMY, 1, ZDUMMY, 1, 697 $ WORK, 6, RWORK(3), INFO ) 698* 699 SING_MAX = RWORK( 1 ) 700 SING_MIN = RWORK( 2 ) 701* 702 DTEMP = SING_MAX / SING_MIN 703* 704* DTEMP should be bounded by CONST 705* 706 DTEMP = DTEMP - CONST + THRESH 707 IF( DTEMP.GT.RESULT( 4 ) ) 708 $ RESULT( 4 ) = DTEMP 709 K = K + 1 710* 711 END IF 712* 713 K = K + 1 714* 715 GO TO 180 716 190 CONTINUE 717 END IF 718* 719* Print information about the tests that did not pass 720* the threshold. 721* 722 DO 200 K = 3, 4 723 IF( RESULT( K ).GE.THRESH ) THEN 724 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 725 $ CALL ALAHD( NOUT, PATH ) 726 WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K, 727 $ RESULT( K ) 728 NFAIL = NFAIL + 1 729 END IF 730 200 CONTINUE 731 NRUN = NRUN + 2 732* 733* Skip the other tests if this is not the first block 734* size. 735* 736 IF( INB.GT.1 ) 737 $ GO TO 240 738* 739* Do only the condition estimate if INFO is not 0. 740* 741 IF( TRFCON ) THEN 742 RCONDC = ZERO 743 GO TO 230 744 END IF 745* 746* Do for each value of NRHS in NSVAL. 747* 748 DO 220 IRHS = 1, NNS 749 NRHS = NSVAL( IRHS ) 750* 751* Begin loop over NRHS values 752* 753* 754*+ TEST 5 ( Using TRS_3) 755* Solve and compute residual for A * X = B. 756* 757* Choose a set of NRHS random solution vectors 758* stored in XACT and set up the right hand side B 759* 760 SRNAMT = 'ZLARHS' 761 CALL ZLARHS( MATPATH, XTYPE, UPLO, ' ', N, N, 762 $ KL, KU, NRHS, A, LDA, XACT, LDA, 763 $ B, LDA, ISEED, INFO ) 764 CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) 765* 766 SRNAMT = 'ZHETRS_3' 767 CALL ZHETRS_3( UPLO, N, NRHS, AFAC, LDA, E, IWORK, 768 $ X, LDA, INFO ) 769* 770* Check error code from ZHETRS_3 and handle error. 771* 772 IF( INFO.NE.0 ) 773 $ CALL ALAERH( PATH, 'ZHETRS_3', INFO, 0, 774 $ UPLO, N, N, -1, -1, NRHS, IMAT, 775 $ NFAIL, NERRS, NOUT ) 776* 777 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) 778* 779* Compute the residual for the solution 780* 781 CALL ZPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, 782 $ LDA, RWORK, RESULT( 5 ) ) 783* 784*+ TEST 6 785* Check solution from generated exact solution. 786* 787 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 788 $ RESULT( 6 ) ) 789* 790* Print information about the tests that did not pass 791* the threshold. 792* 793 DO 210 K = 5, 6 794 IF( RESULT( K ).GE.THRESH ) THEN 795 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 796 $ CALL ALAHD( NOUT, PATH ) 797 WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS, 798 $ IMAT, K, RESULT( K ) 799 NFAIL = NFAIL + 1 800 END IF 801 210 CONTINUE 802 NRUN = NRUN + 2 803* 804* End do for each value of NRHS in NSVAL. 805* 806 220 CONTINUE 807* 808*+ TEST 7 809* Get an estimate of RCOND = 1/CNDNUM. 810* 811 230 CONTINUE 812 ANORM = ZLANHE( '1', UPLO, N, A, LDA, RWORK ) 813 SRNAMT = 'ZHECON_3' 814 CALL ZHECON_3( UPLO, N, AFAC, LDA, E, IWORK, ANORM, 815 $ RCOND, WORK, INFO ) 816* 817* Check error code from ZHECON_3 and handle error. 818* 819 IF( INFO.NE.0 ) 820 $ CALL ALAERH( PATH, 'ZHECON_3', INFO, 0, 821 $ UPLO, N, N, -1, -1, -1, IMAT, 822 $ NFAIL, NERRS, NOUT ) 823* 824* Compute the test ratio to compare values of RCOND 825* 826 RESULT( 7 ) = DGET06( RCOND, RCONDC ) 827* 828* Print information about the tests that did not pass 829* the threshold. 830* 831 IF( RESULT( 7 ).GE.THRESH ) THEN 832 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 833 $ CALL ALAHD( NOUT, PATH ) 834 WRITE( NOUT, FMT = 9997 )UPLO, N, IMAT, 7, 835 $ RESULT( 7 ) 836 NFAIL = NFAIL + 1 837 END IF 838 NRUN = NRUN + 1 839 240 CONTINUE 840* 841 250 CONTINUE 842 260 CONTINUE 843 270 CONTINUE 844* 845* Print a summary of the results. 846* 847 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) 848* 849 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ', 850 $ I2, ', test ', I2, ', ratio =', G12.5 ) 851 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ', 852 $ I2, ', test ', I2, ', ratio =', G12.5 ) 853 9997 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ',', 10X, ' type ', I2, 854 $ ', test ', I2, ', ratio =', G12.5 ) 855 RETURN 856* 857* End of ZCHKHE_RK 858* 859 END 860