1*> \brief \b ZDRVST 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 ZDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, 12* NOUNIT, A, LDA, D1, D2, D3, WA1, WA2, WA3, U, 13* LDU, V, TAU, Z, WORK, LWORK, RWORK, LRWORK, 14* IWORK, LIWORK, RESULT, INFO ) 15* 16* .. Scalar Arguments .. 17* INTEGER INFO, LDA, LDU, LIWORK, LRWORK, LWORK, NOUNIT, 18* $ NSIZES, NTYPES 19* DOUBLE PRECISION THRESH 20* .. 21* .. Array Arguments .. 22* LOGICAL DOTYPE( * ) 23* INTEGER ISEED( 4 ), IWORK( * ), NN( * ) 24* DOUBLE PRECISION D1( * ), D2( * ), D3( * ), RESULT( * ), 25* $ RWORK( * ), WA1( * ), WA2( * ), WA3( * ) 26* COMPLEX*16 A( LDA, * ), TAU( * ), U( LDU, * ), 27* $ V( LDU, * ), WORK( * ), Z( LDU, * ) 28* .. 29* 30* 31*> \par Purpose: 32* ============= 33*> 34*> \verbatim 35*> 36*> ZDRVST checks the Hermitian eigenvalue problem drivers. 37*> 38*> ZHEEVD computes all eigenvalues and, optionally, 39*> eigenvectors of a complex Hermitian matrix, 40*> using a divide-and-conquer algorithm. 41*> 42*> ZHEEVX computes selected eigenvalues and, optionally, 43*> eigenvectors of a complex Hermitian matrix. 44*> 45*> ZHEEVR computes selected eigenvalues and, optionally, 46*> eigenvectors of a complex Hermitian matrix 47*> using the Relatively Robust Representation where it can. 48*> 49*> ZHPEVD computes all eigenvalues and, optionally, 50*> eigenvectors of a complex Hermitian matrix in packed 51*> storage, using a divide-and-conquer algorithm. 52*> 53*> ZHPEVX computes selected eigenvalues and, optionally, 54*> eigenvectors of a complex Hermitian matrix in packed 55*> storage. 56*> 57*> ZHBEVD computes all eigenvalues and, optionally, 58*> eigenvectors of a complex Hermitian band matrix, 59*> using a divide-and-conquer algorithm. 60*> 61*> ZHBEVX computes selected eigenvalues and, optionally, 62*> eigenvectors of a complex Hermitian band matrix. 63*> 64*> ZHEEV computes all eigenvalues and, optionally, 65*> eigenvectors of a complex Hermitian matrix. 66*> 67*> ZHPEV computes all eigenvalues and, optionally, 68*> eigenvectors of a complex Hermitian matrix in packed 69*> storage. 70*> 71*> ZHBEV computes all eigenvalues and, optionally, 72*> eigenvectors of a complex Hermitian band matrix. 73*> 74*> When ZDRVST is called, a number of matrix "sizes" ("n's") and a 75*> number of matrix "types" are specified. For each size ("n") 76*> and each type of matrix, one matrix will be generated and used 77*> to test the appropriate drivers. For each matrix and each 78*> driver routine called, the following tests will be performed: 79*> 80*> (1) | A - Z D Z' | / ( |A| n ulp ) 81*> 82*> (2) | I - Z Z' | / ( n ulp ) 83*> 84*> (3) | D1 - D2 | / ( |D1| ulp ) 85*> 86*> where Z is the matrix of eigenvectors returned when the 87*> eigenvector option is given and D1 and D2 are the eigenvalues 88*> returned with and without the eigenvector option. 89*> 90*> The "sizes" are specified by an array NN(1:NSIZES); the value of 91*> each element NN(j) specifies one size. 92*> The "types" are specified by a logical array DOTYPE( 1:NTYPES ); 93*> if DOTYPE(j) is .TRUE., then matrix type "j" will be generated. 94*> Currently, the list of possible types is: 95*> 96*> (1) The zero matrix. 97*> (2) The identity matrix. 98*> 99*> (3) A diagonal matrix with evenly spaced entries 100*> 1, ..., ULP and random signs. 101*> (ULP = (first number larger than 1) - 1 ) 102*> (4) A diagonal matrix with geometrically spaced entries 103*> 1, ..., ULP and random signs. 104*> (5) A diagonal matrix with "clustered" entries 1, ULP, ..., ULP 105*> and random signs. 106*> 107*> (6) Same as (4), but multiplied by SQRT( overflow threshold ) 108*> (7) Same as (4), but multiplied by SQRT( underflow threshold ) 109*> 110*> (8) A matrix of the form U* D U, where U is unitary and 111*> D has evenly spaced entries 1, ..., ULP with random signs 112*> on the diagonal. 113*> 114*> (9) A matrix of the form U* D U, where U is unitary and 115*> D has geometrically spaced entries 1, ..., ULP with random 116*> signs on the diagonal. 117*> 118*> (10) A matrix of the form U* D U, where U is unitary and 119*> D has "clustered" entries 1, ULP,..., ULP with random 120*> signs on the diagonal. 121*> 122*> (11) Same as (8), but multiplied by SQRT( overflow threshold ) 123*> (12) Same as (8), but multiplied by SQRT( underflow threshold ) 124*> 125*> (13) Symmetric matrix with random entries chosen from (-1,1). 126*> (14) Same as (13), but multiplied by SQRT( overflow threshold ) 127*> (15) Same as (13), but multiplied by SQRT( underflow threshold ) 128*> (16) A band matrix with half bandwidth randomly chosen between 129*> 0 and N-1, with evenly spaced eigenvalues 1, ..., ULP 130*> with random signs. 131*> (17) Same as (16), but multiplied by SQRT( overflow threshold ) 132*> (18) Same as (16), but multiplied by SQRT( underflow threshold ) 133*> \endverbatim 134* 135* Arguments: 136* ========== 137* 138*> \verbatim 139*> NSIZES INTEGER 140*> The number of sizes of matrices to use. If it is zero, 141*> ZDRVST does nothing. It must be at least zero. 142*> Not modified. 143*> 144*> NN INTEGER array, dimension (NSIZES) 145*> An array containing the sizes to be used for the matrices. 146*> Zero values will be skipped. The values must be at least 147*> zero. 148*> Not modified. 149*> 150*> NTYPES INTEGER 151*> The number of elements in DOTYPE. If it is zero, ZDRVST 152*> does nothing. It must be at least zero. If it is MAXTYP+1 153*> and NSIZES is 1, then an additional type, MAXTYP+1 is 154*> defined, which is to use whatever matrix is in A. This 155*> is only useful if DOTYPE(1:MAXTYP) is .FALSE. and 156*> DOTYPE(MAXTYP+1) is .TRUE. . 157*> Not modified. 158*> 159*> DOTYPE LOGICAL array, dimension (NTYPES) 160*> If DOTYPE(j) is .TRUE., then for each size in NN a 161*> matrix of that size and of type j will be generated. 162*> If NTYPES is smaller than the maximum number of types 163*> defined (PARAMETER MAXTYP), then types NTYPES+1 through 164*> MAXTYP will not be generated. If NTYPES is larger 165*> than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES) 166*> will be ignored. 167*> Not modified. 168*> 169*> ISEED INTEGER array, dimension (4) 170*> On entry ISEED specifies the seed of the random number 171*> generator. The array elements should be between 0 and 4095; 172*> if not they will be reduced mod 4096. Also, ISEED(4) must 173*> be odd. The random number generator uses a linear 174*> congruential sequence limited to small integers, and so 175*> should produce machine independent random numbers. The 176*> values of ISEED are changed on exit, and can be used in the 177*> next call to ZDRVST to continue the same random number 178*> sequence. 179*> Modified. 180*> 181*> THRESH DOUBLE PRECISION 182*> A test will count as "failed" if the "error", computed as 183*> described above, exceeds THRESH. Note that the error 184*> is scaled to be O(1), so THRESH should be a reasonably 185*> small multiple of 1, e.g., 10 or 100. In particular, 186*> it should not depend on the precision (single vs. double) 187*> or the size of the matrix. It must be at least zero. 188*> Not modified. 189*> 190*> NOUNIT INTEGER 191*> The FORTRAN unit number for printing out error messages 192*> (e.g., if a routine returns IINFO not equal to 0.) 193*> Not modified. 194*> 195*> A COMPLEX*16 array, dimension (LDA , max(NN)) 196*> Used to hold the matrix whose eigenvalues are to be 197*> computed. On exit, A contains the last matrix actually 198*> used. 199*> Modified. 200*> 201*> LDA INTEGER 202*> The leading dimension of A. It must be at 203*> least 1 and at least max( NN ). 204*> Not modified. 205*> 206*> D1 DOUBLE PRECISION array, dimension (max(NN)) 207*> The eigenvalues of A, as computed by ZSTEQR simlutaneously 208*> with Z. On exit, the eigenvalues in D1 correspond with the 209*> matrix in A. 210*> Modified. 211*> 212*> D2 DOUBLE PRECISION array, dimension (max(NN)) 213*> The eigenvalues of A, as computed by ZSTEQR if Z is not 214*> computed. On exit, the eigenvalues in D2 correspond with 215*> the matrix in A. 216*> Modified. 217*> 218*> D3 DOUBLE PRECISION array, dimension (max(NN)) 219*> The eigenvalues of A, as computed by DSTERF. On exit, the 220*> eigenvalues in D3 correspond with the matrix in A. 221*> Modified. 222*> 223*> WA1 DOUBLE PRECISION array, dimension 224*> 225*> WA2 DOUBLE PRECISION array, dimension 226*> 227*> WA3 DOUBLE PRECISION array, dimension 228*> 229*> U COMPLEX*16 array, dimension (LDU, max(NN)) 230*> The unitary matrix computed by ZHETRD + ZUNGC3. 231*> Modified. 232*> 233*> LDU INTEGER 234*> The leading dimension of U, Z, and V. It must be at 235*> least 1 and at least max( NN ). 236*> Not modified. 237*> 238*> V COMPLEX*16 array, dimension (LDU, max(NN)) 239*> The Housholder vectors computed by ZHETRD in reducing A to 240*> tridiagonal form. 241*> Modified. 242*> 243*> TAU COMPLEX*16 array, dimension (max(NN)) 244*> The Householder factors computed by ZHETRD in reducing A 245*> to tridiagonal form. 246*> Modified. 247*> 248*> Z COMPLEX*16 array, dimension (LDU, max(NN)) 249*> The unitary matrix of eigenvectors computed by ZHEEVD, 250*> ZHEEVX, ZHPEVD, CHPEVX, ZHBEVD, and CHBEVX. 251*> Modified. 252*> 253*> WORK - COMPLEX*16 array of dimension ( LWORK ) 254*> Workspace. 255*> Modified. 256*> 257*> LWORK - INTEGER 258*> The number of entries in WORK. This must be at least 259*> 2*max( NN(j), 2 )**2. 260*> Not modified. 261*> 262*> RWORK DOUBLE PRECISION array, dimension (3*max(NN)) 263*> Workspace. 264*> Modified. 265*> 266*> LRWORK - INTEGER 267*> The number of entries in RWORK. 268*> 269*> IWORK INTEGER array, dimension (6*max(NN)) 270*> Workspace. 271*> Modified. 272*> 273*> LIWORK - INTEGER 274*> The number of entries in IWORK. 275*> 276*> RESULT DOUBLE PRECISION array, dimension (??) 277*> The values computed by the tests described above. 278*> The values are currently limited to 1/ulp, to avoid 279*> overflow. 280*> Modified. 281*> 282*> INFO INTEGER 283*> If 0, then everything ran OK. 284*> -1: NSIZES < 0 285*> -2: Some NN(j) < 0 286*> -3: NTYPES < 0 287*> -5: THRESH < 0 288*> -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ). 289*> -16: LDU < 1 or LDU < NMAX. 290*> -21: LWORK too small. 291*> If DLATMR, SLATMS, ZHETRD, DORGC3, ZSTEQR, DSTERF, 292*> or DORMC2 returns an error code, the 293*> absolute value of it is returned. 294*> Modified. 295*> 296*>----------------------------------------------------------------------- 297*> 298*> Some Local Variables and Parameters: 299*> ---- ----- --------- --- ---------- 300*> ZERO, ONE Real 0 and 1. 301*> MAXTYP The number of types defined. 302*> NTEST The number of tests performed, or which can 303*> be performed so far, for the current matrix. 304*> NTESTT The total number of tests performed so far. 305*> NMAX Largest value in NN. 306*> NMATS The number of matrices generated so far. 307*> NERRS The number of tests which have exceeded THRESH 308*> so far (computed by DLAFTS). 309*> COND, IMODE Values to be passed to the matrix generators. 310*> ANORM Norm of A; passed to matrix generators. 311*> 312*> OVFL, UNFL Overflow and underflow thresholds. 313*> ULP, ULPINV Finest relative precision and its inverse. 314*> RTOVFL, RTUNFL Square roots of the previous 2 values. 315*> The following four arrays decode JTYPE: 316*> KTYPE(j) The general type (1-10) for type "j". 317*> KMODE(j) The MODE value to be passed to the matrix 318*> generator for type "j". 319*> KMAGN(j) The order of magnitude ( O(1), 320*> O(overflow^(1/2) ), O(underflow^(1/2) ) 321*> \endverbatim 322* 323* Authors: 324* ======== 325* 326*> \author Univ. of Tennessee 327*> \author Univ. of California Berkeley 328*> \author Univ. of Colorado Denver 329*> \author NAG Ltd. 330* 331*> \date November 2011 332* 333*> \ingroup complex16_eig 334* 335* ===================================================================== 336 SUBROUTINE ZDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, 337 $ NOUNIT, A, LDA, D1, D2, D3, WA1, WA2, WA3, U, 338 $ LDU, V, TAU, Z, WORK, LWORK, RWORK, LRWORK, 339 $ IWORK, LIWORK, RESULT, INFO ) 340* 341* -- LAPACK test routine (version 3.4.0) -- 342* -- LAPACK is a software package provided by Univ. of Tennessee, -- 343* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 344* November 2011 345* 346* .. Scalar Arguments .. 347 INTEGER INFO, LDA, LDU, LIWORK, LRWORK, LWORK, NOUNIT, 348 $ NSIZES, NTYPES 349 DOUBLE PRECISION THRESH 350* .. 351* .. Array Arguments .. 352 LOGICAL DOTYPE( * ) 353 INTEGER ISEED( 4 ), IWORK( * ), NN( * ) 354 DOUBLE PRECISION D1( * ), D2( * ), D3( * ), RESULT( * ), 355 $ RWORK( * ), WA1( * ), WA2( * ), WA3( * ) 356 COMPLEX*16 A( LDA, * ), TAU( * ), U( LDU, * ), 357 $ V( LDU, * ), WORK( * ), Z( LDU, * ) 358* .. 359* 360* ===================================================================== 361* 362* 363* .. Parameters .. 364 DOUBLE PRECISION ZERO, ONE, TWO, TEN 365 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0, 366 $ TEN = 10.0D+0 ) 367 DOUBLE PRECISION HALF 368 PARAMETER ( HALF = ONE / TWO ) 369 COMPLEX*16 CZERO, CONE 370 PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ), 371 $ CONE = ( 1.0D+0, 0.0D+0 ) ) 372 INTEGER MAXTYP 373 PARAMETER ( MAXTYP = 18 ) 374* .. 375* .. Local Scalars .. 376 LOGICAL BADNN 377 CHARACTER UPLO 378 INTEGER I, IDIAG, IHBW, IINFO, IL, IMODE, INDWRK, INDX, 379 $ IROW, ITEMP, ITYPE, IU, IUPLO, J, J1, J2, JCOL, 380 $ JSIZE, JTYPE, KD, LGN, LIWEDC, LRWEDC, LWEDC, 381 $ M, M2, M3, MTYPES, N, NERRS, NMATS, NMAX, 382 $ NTEST, NTESTT 383 DOUBLE PRECISION ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL, 384 $ RTUNFL, TEMP1, TEMP2, TEMP3, ULP, ULPINV, UNFL, 385 $ VL, VU 386* .. 387* .. Local Arrays .. 388 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ), 389 $ ISEED3( 4 ), KMAGN( MAXTYP ), KMODE( MAXTYP ), 390 $ KTYPE( MAXTYP ) 391* .. 392* .. External Functions .. 393 DOUBLE PRECISION DLAMCH, DLARND, DSXT1 394 EXTERNAL DLAMCH, DLARND, DSXT1 395* .. 396* .. External Subroutines .. 397 EXTERNAL ALASVM, DLABAD, DLAFTS, XERBLA, ZHBEV, ZHBEVD, 398 $ ZHBEVX, ZHEEV, ZHEEVD, ZHEEVR, ZHEEVX, ZHET21, 399 $ ZHET22, ZHPEV, ZHPEVD, ZHPEVX, ZLACPY, ZLASET, 400 $ ZLATMR, ZLATMS 401* .. 402* .. Intrinsic Functions .. 403 INTRINSIC ABS, DBLE, INT, LOG, MAX, MIN, SQRT 404* .. 405* .. Data statements .. 406 DATA KTYPE / 1, 2, 5*4, 5*5, 3*8, 3*9 / 407 DATA KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1, 408 $ 2, 3, 1, 2, 3 / 409 DATA KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0, 410 $ 0, 0, 4, 4, 4 / 411* .. 412* .. Executable Statements .. 413* 414* 1) Check for errors 415* 416 NTESTT = 0 417 INFO = 0 418* 419 BADNN = .FALSE. 420 NMAX = 1 421 DO 10 J = 1, NSIZES 422 NMAX = MAX( NMAX, NN( J ) ) 423 IF( NN( J ).LT.0 ) 424 $ BADNN = .TRUE. 425 10 CONTINUE 426* 427* Check for errors 428* 429 IF( NSIZES.LT.0 ) THEN 430 INFO = -1 431 ELSE IF( BADNN ) THEN 432 INFO = -2 433 ELSE IF( NTYPES.LT.0 ) THEN 434 INFO = -3 435 ELSE IF( LDA.LT.NMAX ) THEN 436 INFO = -9 437 ELSE IF( LDU.LT.NMAX ) THEN 438 INFO = -16 439 ELSE IF( 2*MAX( 2, NMAX )**2.GT.LWORK ) THEN 440 INFO = -22 441 END IF 442* 443 IF( INFO.NE.0 ) THEN 444 CALL XERBLA( 'ZDRVST', -INFO ) 445 RETURN 446 END IF 447* 448* Quick return if nothing to do 449* 450 IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 ) 451 $ RETURN 452* 453* More Important constants 454* 455 UNFL = DLAMCH( 'Safe minimum' ) 456 OVFL = DLAMCH( 'Overflow' ) 457 CALL DLABAD( UNFL, OVFL ) 458 ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) 459 ULPINV = ONE / ULP 460 RTUNFL = SQRT( UNFL ) 461 RTOVFL = SQRT( OVFL ) 462* 463* Loop over sizes, types 464* 465 DO 20 I = 1, 4 466 ISEED2( I ) = ISEED( I ) 467 ISEED3( I ) = ISEED( I ) 468 20 CONTINUE 469* 470 NERRS = 0 471 NMATS = 0 472* 473 DO 1220 JSIZE = 1, NSIZES 474 N = NN( JSIZE ) 475 IF( N.GT.0 ) THEN 476 LGN = INT( LOG( DBLE( N ) ) / LOG( TWO ) ) 477 IF( 2**LGN.LT.N ) 478 $ LGN = LGN + 1 479 IF( 2**LGN.LT.N ) 480 $ LGN = LGN + 1 481 LWEDC = MAX( 2*N+N*N, 2*N*N ) 482 LRWEDC = 1 + 4*N + 2*N*LGN + 3*N**2 483 LIWEDC = 3 + 5*N 484 ELSE 485 LWEDC = 2 486 LRWEDC = 8 487 LIWEDC = 8 488 END IF 489 ANINV = ONE / DBLE( MAX( 1, N ) ) 490* 491 IF( NSIZES.NE.1 ) THEN 492 MTYPES = MIN( MAXTYP, NTYPES ) 493 ELSE 494 MTYPES = MIN( MAXTYP+1, NTYPES ) 495 END IF 496* 497 DO 1210 JTYPE = 1, MTYPES 498 IF( .NOT.DOTYPE( JTYPE ) ) 499 $ GO TO 1210 500 NMATS = NMATS + 1 501 NTEST = 0 502* 503 DO 30 J = 1, 4 504 IOLDSD( J ) = ISEED( J ) 505 30 CONTINUE 506* 507* 2) Compute "A" 508* 509* Control parameters: 510* 511* KMAGN KMODE KTYPE 512* =1 O(1) clustered 1 zero 513* =2 large clustered 2 identity 514* =3 small exponential (none) 515* =4 arithmetic diagonal, (w/ eigenvalues) 516* =5 random log Hermitian, w/ eigenvalues 517* =6 random (none) 518* =7 random diagonal 519* =8 random Hermitian 520* =9 band Hermitian, w/ eigenvalues 521* 522 IF( MTYPES.GT.MAXTYP ) 523 $ GO TO 110 524* 525 ITYPE = KTYPE( JTYPE ) 526 IMODE = KMODE( JTYPE ) 527* 528* Compute norm 529* 530 GO TO ( 40, 50, 60 )KMAGN( JTYPE ) 531* 532 40 CONTINUE 533 ANORM = ONE 534 GO TO 70 535* 536 50 CONTINUE 537 ANORM = ( RTOVFL*ULP )*ANINV 538 GO TO 70 539* 540 60 CONTINUE 541 ANORM = RTUNFL*N*ULPINV 542 GO TO 70 543* 544 70 CONTINUE 545* 546 CALL ZLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA ) 547 IINFO = 0 548 COND = ULPINV 549* 550* Special Matrices -- Identity & Jordan block 551* 552* Zero 553* 554 IF( ITYPE.EQ.1 ) THEN 555 IINFO = 0 556* 557 ELSE IF( ITYPE.EQ.2 ) THEN 558* 559* Identity 560* 561 DO 80 JCOL = 1, N 562 A( JCOL, JCOL ) = ANORM 563 80 CONTINUE 564* 565 ELSE IF( ITYPE.EQ.4 ) THEN 566* 567* Diagonal Matrix, [Eigen]values Specified 568* 569 CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND, 570 $ ANORM, 0, 0, 'N', A, LDA, WORK, IINFO ) 571* 572 ELSE IF( ITYPE.EQ.5 ) THEN 573* 574* Hermitian, eigenvalues specified 575* 576 CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND, 577 $ ANORM, N, N, 'N', A, LDA, WORK, IINFO ) 578* 579 ELSE IF( ITYPE.EQ.7 ) THEN 580* 581* Diagonal, random eigenvalues 582* 583 CALL ZLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE, 584 $ 'T', 'N', WORK( N+1 ), 1, ONE, 585 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0, 586 $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO ) 587* 588 ELSE IF( ITYPE.EQ.8 ) THEN 589* 590* Hermitian, random eigenvalues 591* 592 CALL ZLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE, 593 $ 'T', 'N', WORK( N+1 ), 1, ONE, 594 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N, 595 $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO ) 596* 597 ELSE IF( ITYPE.EQ.9 ) THEN 598* 599* Hermitian banded, eigenvalues specified 600* 601 IHBW = INT( ( N-1 )*DLARND( 1, ISEED3 ) ) 602 CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND, 603 $ ANORM, IHBW, IHBW, 'Z', U, LDU, WORK, 604 $ IINFO ) 605* 606* Store as dense matrix for most routines. 607* 608 CALL ZLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA ) 609 DO 100 IDIAG = -IHBW, IHBW 610 IROW = IHBW - IDIAG + 1 611 J1 = MAX( 1, IDIAG+1 ) 612 J2 = MIN( N, N+IDIAG ) 613 DO 90 J = J1, J2 614 I = J - IDIAG 615 A( I, J ) = U( IROW, J ) 616 90 CONTINUE 617 100 CONTINUE 618 ELSE 619 IINFO = 1 620 END IF 621* 622 IF( IINFO.NE.0 ) THEN 623 WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE, 624 $ IOLDSD 625 INFO = ABS( IINFO ) 626 RETURN 627 END IF 628* 629 110 CONTINUE 630* 631 ABSTOL = UNFL + UNFL 632 IF( N.LE.1 ) THEN 633 IL = 1 634 IU = N 635 ELSE 636 IL = 1 + INT( ( N-1 )*DLARND( 1, ISEED2 ) ) 637 IU = 1 + INT( ( N-1 )*DLARND( 1, ISEED2 ) ) 638 IF( IL.GT.IU ) THEN 639 ITEMP = IL 640 IL = IU 641 IU = ITEMP 642 END IF 643 END IF 644* 645* Perform tests storing upper or lower triangular 646* part of matrix. 647* 648 DO 1200 IUPLO = 0, 1 649 IF( IUPLO.EQ.0 ) THEN 650 UPLO = 'L' 651 ELSE 652 UPLO = 'U' 653 END IF 654* 655* Call ZHEEVD and CHEEVX. 656* 657 CALL ZLACPY( ' ', N, N, A, LDA, V, LDU ) 658* 659 NTEST = NTEST + 1 660 CALL ZHEEVD( 'V', UPLO, N, A, LDU, D1, WORK, LWEDC, 661 $ RWORK, LRWEDC, IWORK, LIWEDC, IINFO ) 662 IF( IINFO.NE.0 ) THEN 663 WRITE( NOUNIT, FMT = 9999 )'ZHEEVD(V,' // UPLO // 664 $ ')', IINFO, N, JTYPE, IOLDSD 665 INFO = ABS( IINFO ) 666 IF( IINFO.LT.0 ) THEN 667 RETURN 668 ELSE 669 RESULT( NTEST ) = ULPINV 670 RESULT( NTEST+1 ) = ULPINV 671 RESULT( NTEST+2 ) = ULPINV 672 GO TO 130 673 END IF 674 END IF 675* 676* Do tests 1 and 2. 677* 678 CALL ZHET21( 1, UPLO, N, 0, V, LDU, D1, D2, A, LDU, Z, 679 $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 680* 681 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 682* 683 NTEST = NTEST + 2 684 CALL ZHEEVD( 'N', UPLO, N, A, LDU, D3, WORK, LWEDC, 685 $ RWORK, LRWEDC, IWORK, LIWEDC, IINFO ) 686 IF( IINFO.NE.0 ) THEN 687 WRITE( NOUNIT, FMT = 9999 )'ZHEEVD(N,' // UPLO // 688 $ ')', IINFO, N, JTYPE, IOLDSD 689 INFO = ABS( IINFO ) 690 IF( IINFO.LT.0 ) THEN 691 RETURN 692 ELSE 693 RESULT( NTEST ) = ULPINV 694 GO TO 130 695 END IF 696 END IF 697* 698* Do test 3. 699* 700 TEMP1 = ZERO 701 TEMP2 = ZERO 702 DO 120 J = 1, N 703 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 704 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 705 120 CONTINUE 706 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 707 $ ULP*MAX( TEMP1, TEMP2 ) ) 708* 709 130 CONTINUE 710 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 711* 712 NTEST = NTEST + 1 713* 714 IF( N.GT.0 ) THEN 715 TEMP3 = MAX( ABS( D1( 1 ) ), ABS( D1( N ) ) ) 716 IF( IL.NE.1 ) THEN 717 VL = D1( IL ) - MAX( HALF*( D1( IL )-D1( IL-1 ) ), 718 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 719 ELSE IF( N.GT.0 ) THEN 720 VL = D1( 1 ) - MAX( HALF*( D1( N )-D1( 1 ) ), 721 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 722 END IF 723 IF( IU.NE.N ) THEN 724 VU = D1( IU ) + MAX( HALF*( D1( IU+1 )-D1( IU ) ), 725 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 726 ELSE IF( N.GT.0 ) THEN 727 VU = D1( N ) + MAX( HALF*( D1( N )-D1( 1 ) ), 728 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 729 END IF 730 ELSE 731 TEMP3 = ZERO 732 VL = ZERO 733 VU = ONE 734 END IF 735* 736 CALL ZHEEVX( 'V', 'A', UPLO, N, A, LDU, VL, VU, IL, IU, 737 $ ABSTOL, M, WA1, Z, LDU, WORK, LWORK, RWORK, 738 $ IWORK, IWORK( 5*N+1 ), IINFO ) 739 IF( IINFO.NE.0 ) THEN 740 WRITE( NOUNIT, FMT = 9999 )'ZHEEVX(V,A,' // UPLO // 741 $ ')', IINFO, N, JTYPE, IOLDSD 742 INFO = ABS( IINFO ) 743 IF( IINFO.LT.0 ) THEN 744 RETURN 745 ELSE 746 RESULT( NTEST ) = ULPINV 747 RESULT( NTEST+1 ) = ULPINV 748 RESULT( NTEST+2 ) = ULPINV 749 GO TO 150 750 END IF 751 END IF 752* 753* Do tests 4 and 5. 754* 755 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 756* 757 CALL ZHET21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V, 758 $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 759* 760 NTEST = NTEST + 2 761 CALL ZHEEVX( 'N', 'A', UPLO, N, A, LDU, VL, VU, IL, IU, 762 $ ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, RWORK, 763 $ IWORK, IWORK( 5*N+1 ), IINFO ) 764 IF( IINFO.NE.0 ) THEN 765 WRITE( NOUNIT, FMT = 9999 )'ZHEEVX(N,A,' // UPLO // 766 $ ')', IINFO, N, JTYPE, IOLDSD 767 INFO = ABS( IINFO ) 768 IF( IINFO.LT.0 ) THEN 769 RETURN 770 ELSE 771 RESULT( NTEST ) = ULPINV 772 GO TO 150 773 END IF 774 END IF 775* 776* Do test 6. 777* 778 TEMP1 = ZERO 779 TEMP2 = ZERO 780 DO 140 J = 1, N 781 TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) ) 782 TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) ) 783 140 CONTINUE 784 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 785 $ ULP*MAX( TEMP1, TEMP2 ) ) 786* 787 150 CONTINUE 788 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 789* 790 NTEST = NTEST + 1 791* 792 CALL ZHEEVX( 'V', 'I', UPLO, N, A, LDU, VL, VU, IL, IU, 793 $ ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, RWORK, 794 $ IWORK, IWORK( 5*N+1 ), IINFO ) 795 IF( IINFO.NE.0 ) THEN 796 WRITE( NOUNIT, FMT = 9999 )'ZHEEVX(V,I,' // UPLO // 797 $ ')', IINFO, N, JTYPE, IOLDSD 798 INFO = ABS( IINFO ) 799 IF( IINFO.LT.0 ) THEN 800 RETURN 801 ELSE 802 RESULT( NTEST ) = ULPINV 803 GO TO 160 804 END IF 805 END IF 806* 807* Do tests 7 and 8. 808* 809 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 810* 811 CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 812 $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 813* 814 NTEST = NTEST + 2 815* 816 CALL ZHEEVX( 'N', 'I', UPLO, N, A, LDU, VL, VU, IL, IU, 817 $ ABSTOL, M3, WA3, Z, LDU, WORK, LWORK, RWORK, 818 $ IWORK, IWORK( 5*N+1 ), IINFO ) 819 IF( IINFO.NE.0 ) THEN 820 WRITE( NOUNIT, FMT = 9999 )'ZHEEVX(N,I,' // UPLO // 821 $ ')', IINFO, N, JTYPE, IOLDSD 822 INFO = ABS( IINFO ) 823 IF( IINFO.LT.0 ) THEN 824 RETURN 825 ELSE 826 RESULT( NTEST ) = ULPINV 827 GO TO 160 828 END IF 829 END IF 830* 831* Do test 9. 832* 833 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 834 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 835 IF( N.GT.0 ) THEN 836 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 837 ELSE 838 TEMP3 = ZERO 839 END IF 840 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 841 $ MAX( UNFL, TEMP3*ULP ) 842* 843 160 CONTINUE 844 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 845* 846 NTEST = NTEST + 1 847* 848 CALL ZHEEVX( 'V', 'V', UPLO, N, A, LDU, VL, VU, IL, IU, 849 $ ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, RWORK, 850 $ IWORK, IWORK( 5*N+1 ), IINFO ) 851 IF( IINFO.NE.0 ) THEN 852 WRITE( NOUNIT, FMT = 9999 )'ZHEEVX(V,V,' // UPLO // 853 $ ')', IINFO, N, JTYPE, IOLDSD 854 INFO = ABS( IINFO ) 855 IF( IINFO.LT.0 ) THEN 856 RETURN 857 ELSE 858 RESULT( NTEST ) = ULPINV 859 GO TO 170 860 END IF 861 END IF 862* 863* Do tests 10 and 11. 864* 865 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 866* 867 CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 868 $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 869* 870 NTEST = NTEST + 2 871* 872 CALL ZHEEVX( 'N', 'V', UPLO, N, A, LDU, VL, VU, IL, IU, 873 $ ABSTOL, M3, WA3, Z, LDU, WORK, LWORK, RWORK, 874 $ IWORK, IWORK( 5*N+1 ), IINFO ) 875 IF( IINFO.NE.0 ) THEN 876 WRITE( NOUNIT, FMT = 9999 )'ZHEEVX(N,V,' // UPLO // 877 $ ')', IINFO, N, JTYPE, IOLDSD 878 INFO = ABS( IINFO ) 879 IF( IINFO.LT.0 ) THEN 880 RETURN 881 ELSE 882 RESULT( NTEST ) = ULPINV 883 GO TO 170 884 END IF 885 END IF 886* 887 IF( M3.EQ.0 .AND. N.GT.0 ) THEN 888 RESULT( NTEST ) = ULPINV 889 GO TO 170 890 END IF 891* 892* Do test 12. 893* 894 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 895 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 896 IF( N.GT.0 ) THEN 897 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 898 ELSE 899 TEMP3 = ZERO 900 END IF 901 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 902 $ MAX( UNFL, TEMP3*ULP ) 903* 904 170 CONTINUE 905* 906* Call ZHPEVD and CHPEVX. 907* 908 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 909* 910* Load array WORK with the upper or lower triangular 911* part of the matrix in packed form. 912* 913 IF( IUPLO.EQ.1 ) THEN 914 INDX = 1 915 DO 190 J = 1, N 916 DO 180 I = 1, J 917 WORK( INDX ) = A( I, J ) 918 INDX = INDX + 1 919 180 CONTINUE 920 190 CONTINUE 921 ELSE 922 INDX = 1 923 DO 210 J = 1, N 924 DO 200 I = J, N 925 WORK( INDX ) = A( I, J ) 926 INDX = INDX + 1 927 200 CONTINUE 928 210 CONTINUE 929 END IF 930* 931 NTEST = NTEST + 1 932 INDWRK = N*( N+1 ) / 2 + 1 933 CALL ZHPEVD( 'V', UPLO, N, WORK, D1, Z, LDU, 934 $ WORK( INDWRK ), LWEDC, RWORK, LRWEDC, IWORK, 935 $ LIWEDC, IINFO ) 936 IF( IINFO.NE.0 ) THEN 937 WRITE( NOUNIT, FMT = 9999 )'ZHPEVD(V,' // UPLO // 938 $ ')', IINFO, N, JTYPE, IOLDSD 939 INFO = ABS( IINFO ) 940 IF( IINFO.LT.0 ) THEN 941 RETURN 942 ELSE 943 RESULT( NTEST ) = ULPINV 944 RESULT( NTEST+1 ) = ULPINV 945 RESULT( NTEST+2 ) = ULPINV 946 GO TO 270 947 END IF 948 END IF 949* 950* Do tests 13 and 14. 951* 952 CALL ZHET21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V, 953 $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 954* 955 IF( IUPLO.EQ.1 ) THEN 956 INDX = 1 957 DO 230 J = 1, N 958 DO 220 I = 1, J 959 WORK( INDX ) = A( I, J ) 960 INDX = INDX + 1 961 220 CONTINUE 962 230 CONTINUE 963 ELSE 964 INDX = 1 965 DO 250 J = 1, N 966 DO 240 I = J, N 967 WORK( INDX ) = A( I, J ) 968 INDX = INDX + 1 969 240 CONTINUE 970 250 CONTINUE 971 END IF 972* 973 NTEST = NTEST + 2 974 INDWRK = N*( N+1 ) / 2 + 1 975 CALL ZHPEVD( 'N', UPLO, N, WORK, D3, Z, LDU, 976 $ WORK( INDWRK ), LWEDC, RWORK, LRWEDC, IWORK, 977 $ LIWEDC, IINFO ) 978 IF( IINFO.NE.0 ) THEN 979 WRITE( NOUNIT, FMT = 9999 )'ZHPEVD(N,' // UPLO // 980 $ ')', IINFO, N, JTYPE, IOLDSD 981 INFO = ABS( IINFO ) 982 IF( IINFO.LT.0 ) THEN 983 RETURN 984 ELSE 985 RESULT( NTEST ) = ULPINV 986 GO TO 270 987 END IF 988 END IF 989* 990* Do test 15. 991* 992 TEMP1 = ZERO 993 TEMP2 = ZERO 994 DO 260 J = 1, N 995 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 996 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 997 260 CONTINUE 998 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 999 $ ULP*MAX( TEMP1, TEMP2 ) ) 1000* 1001* Load array WORK with the upper or lower triangular part 1002* of the matrix in packed form. 1003* 1004 270 CONTINUE 1005 IF( IUPLO.EQ.1 ) THEN 1006 INDX = 1 1007 DO 290 J = 1, N 1008 DO 280 I = 1, J 1009 WORK( INDX ) = A( I, J ) 1010 INDX = INDX + 1 1011 280 CONTINUE 1012 290 CONTINUE 1013 ELSE 1014 INDX = 1 1015 DO 310 J = 1, N 1016 DO 300 I = J, N 1017 WORK( INDX ) = A( I, J ) 1018 INDX = INDX + 1 1019 300 CONTINUE 1020 310 CONTINUE 1021 END IF 1022* 1023 NTEST = NTEST + 1 1024* 1025 IF( N.GT.0 ) THEN 1026 TEMP3 = MAX( ABS( D1( 1 ) ), ABS( D1( N ) ) ) 1027 IF( IL.NE.1 ) THEN 1028 VL = D1( IL ) - MAX( HALF*( D1( IL )-D1( IL-1 ) ), 1029 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 1030 ELSE IF( N.GT.0 ) THEN 1031 VL = D1( 1 ) - MAX( HALF*( D1( N )-D1( 1 ) ), 1032 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 1033 END IF 1034 IF( IU.NE.N ) THEN 1035 VU = D1( IU ) + MAX( HALF*( D1( IU+1 )-D1( IU ) ), 1036 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 1037 ELSE IF( N.GT.0 ) THEN 1038 VU = D1( N ) + MAX( HALF*( D1( N )-D1( 1 ) ), 1039 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 1040 END IF 1041 ELSE 1042 TEMP3 = ZERO 1043 VL = ZERO 1044 VU = ONE 1045 END IF 1046* 1047 CALL ZHPEVX( 'V', 'A', UPLO, N, WORK, VL, VU, IL, IU, 1048 $ ABSTOL, M, WA1, Z, LDU, V, RWORK, IWORK, 1049 $ IWORK( 5*N+1 ), IINFO ) 1050 IF( IINFO.NE.0 ) THEN 1051 WRITE( NOUNIT, FMT = 9999 )'ZHPEVX(V,A,' // UPLO // 1052 $ ')', IINFO, N, JTYPE, IOLDSD 1053 INFO = ABS( IINFO ) 1054 IF( IINFO.LT.0 ) THEN 1055 RETURN 1056 ELSE 1057 RESULT( NTEST ) = ULPINV 1058 RESULT( NTEST+1 ) = ULPINV 1059 RESULT( NTEST+2 ) = ULPINV 1060 GO TO 370 1061 END IF 1062 END IF 1063* 1064* Do tests 16 and 17. 1065* 1066 CALL ZHET21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V, 1067 $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 1068* 1069 NTEST = NTEST + 2 1070* 1071 IF( IUPLO.EQ.1 ) THEN 1072 INDX = 1 1073 DO 330 J = 1, N 1074 DO 320 I = 1, J 1075 WORK( INDX ) = A( I, J ) 1076 INDX = INDX + 1 1077 320 CONTINUE 1078 330 CONTINUE 1079 ELSE 1080 INDX = 1 1081 DO 350 J = 1, N 1082 DO 340 I = J, N 1083 WORK( INDX ) = A( I, J ) 1084 INDX = INDX + 1 1085 340 CONTINUE 1086 350 CONTINUE 1087 END IF 1088* 1089 CALL ZHPEVX( 'N', 'A', UPLO, N, WORK, VL, VU, IL, IU, 1090 $ ABSTOL, M2, WA2, Z, LDU, V, RWORK, IWORK, 1091 $ IWORK( 5*N+1 ), IINFO ) 1092 IF( IINFO.NE.0 ) THEN 1093 WRITE( NOUNIT, FMT = 9999 )'ZHPEVX(N,A,' // UPLO // 1094 $ ')', IINFO, N, JTYPE, IOLDSD 1095 INFO = ABS( IINFO ) 1096 IF( IINFO.LT.0 ) THEN 1097 RETURN 1098 ELSE 1099 RESULT( NTEST ) = ULPINV 1100 GO TO 370 1101 END IF 1102 END IF 1103* 1104* Do test 18. 1105* 1106 TEMP1 = ZERO 1107 TEMP2 = ZERO 1108 DO 360 J = 1, N 1109 TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) ) 1110 TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) ) 1111 360 CONTINUE 1112 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 1113 $ ULP*MAX( TEMP1, TEMP2 ) ) 1114* 1115 370 CONTINUE 1116 NTEST = NTEST + 1 1117 IF( IUPLO.EQ.1 ) THEN 1118 INDX = 1 1119 DO 390 J = 1, N 1120 DO 380 I = 1, J 1121 WORK( INDX ) = A( I, J ) 1122 INDX = INDX + 1 1123 380 CONTINUE 1124 390 CONTINUE 1125 ELSE 1126 INDX = 1 1127 DO 410 J = 1, N 1128 DO 400 I = J, N 1129 WORK( INDX ) = A( I, J ) 1130 INDX = INDX + 1 1131 400 CONTINUE 1132 410 CONTINUE 1133 END IF 1134* 1135 CALL ZHPEVX( 'V', 'I', UPLO, N, WORK, VL, VU, IL, IU, 1136 $ ABSTOL, M2, WA2, Z, LDU, V, RWORK, IWORK, 1137 $ IWORK( 5*N+1 ), IINFO ) 1138 IF( IINFO.NE.0 ) THEN 1139 WRITE( NOUNIT, FMT = 9999 )'ZHPEVX(V,I,' // UPLO // 1140 $ ')', IINFO, N, JTYPE, IOLDSD 1141 INFO = ABS( IINFO ) 1142 IF( IINFO.LT.0 ) THEN 1143 RETURN 1144 ELSE 1145 RESULT( NTEST ) = ULPINV 1146 RESULT( NTEST+1 ) = ULPINV 1147 RESULT( NTEST+2 ) = ULPINV 1148 GO TO 460 1149 END IF 1150 END IF 1151* 1152* Do tests 19 and 20. 1153* 1154 CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 1155 $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 1156* 1157 NTEST = NTEST + 2 1158* 1159 IF( IUPLO.EQ.1 ) THEN 1160 INDX = 1 1161 DO 430 J = 1, N 1162 DO 420 I = 1, J 1163 WORK( INDX ) = A( I, J ) 1164 INDX = INDX + 1 1165 420 CONTINUE 1166 430 CONTINUE 1167 ELSE 1168 INDX = 1 1169 DO 450 J = 1, N 1170 DO 440 I = J, N 1171 WORK( INDX ) = A( I, J ) 1172 INDX = INDX + 1 1173 440 CONTINUE 1174 450 CONTINUE 1175 END IF 1176* 1177 CALL ZHPEVX( 'N', 'I', UPLO, N, WORK, VL, VU, IL, IU, 1178 $ ABSTOL, M3, WA3, Z, LDU, V, RWORK, IWORK, 1179 $ IWORK( 5*N+1 ), IINFO ) 1180 IF( IINFO.NE.0 ) THEN 1181 WRITE( NOUNIT, FMT = 9999 )'ZHPEVX(N,I,' // UPLO // 1182 $ ')', IINFO, N, JTYPE, IOLDSD 1183 INFO = ABS( IINFO ) 1184 IF( IINFO.LT.0 ) THEN 1185 RETURN 1186 ELSE 1187 RESULT( NTEST ) = ULPINV 1188 GO TO 460 1189 END IF 1190 END IF 1191* 1192* Do test 21. 1193* 1194 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 1195 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 1196 IF( N.GT.0 ) THEN 1197 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 1198 ELSE 1199 TEMP3 = ZERO 1200 END IF 1201 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 1202 $ MAX( UNFL, TEMP3*ULP ) 1203* 1204 460 CONTINUE 1205 NTEST = NTEST + 1 1206 IF( IUPLO.EQ.1 ) THEN 1207 INDX = 1 1208 DO 480 J = 1, N 1209 DO 470 I = 1, J 1210 WORK( INDX ) = A( I, J ) 1211 INDX = INDX + 1 1212 470 CONTINUE 1213 480 CONTINUE 1214 ELSE 1215 INDX = 1 1216 DO 500 J = 1, N 1217 DO 490 I = J, N 1218 WORK( INDX ) = A( I, J ) 1219 INDX = INDX + 1 1220 490 CONTINUE 1221 500 CONTINUE 1222 END IF 1223* 1224 CALL ZHPEVX( 'V', 'V', UPLO, N, WORK, VL, VU, IL, IU, 1225 $ ABSTOL, M2, WA2, Z, LDU, V, RWORK, IWORK, 1226 $ IWORK( 5*N+1 ), IINFO ) 1227 IF( IINFO.NE.0 ) THEN 1228 WRITE( NOUNIT, FMT = 9999 )'ZHPEVX(V,V,' // UPLO // 1229 $ ')', IINFO, N, JTYPE, IOLDSD 1230 INFO = ABS( IINFO ) 1231 IF( IINFO.LT.0 ) THEN 1232 RETURN 1233 ELSE 1234 RESULT( NTEST ) = ULPINV 1235 RESULT( NTEST+1 ) = ULPINV 1236 RESULT( NTEST+2 ) = ULPINV 1237 GO TO 550 1238 END IF 1239 END IF 1240* 1241* Do tests 22 and 23. 1242* 1243 CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 1244 $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 1245* 1246 NTEST = NTEST + 2 1247* 1248 IF( IUPLO.EQ.1 ) THEN 1249 INDX = 1 1250 DO 520 J = 1, N 1251 DO 510 I = 1, J 1252 WORK( INDX ) = A( I, J ) 1253 INDX = INDX + 1 1254 510 CONTINUE 1255 520 CONTINUE 1256 ELSE 1257 INDX = 1 1258 DO 540 J = 1, N 1259 DO 530 I = J, N 1260 WORK( INDX ) = A( I, J ) 1261 INDX = INDX + 1 1262 530 CONTINUE 1263 540 CONTINUE 1264 END IF 1265* 1266 CALL ZHPEVX( 'N', 'V', UPLO, N, WORK, VL, VU, IL, IU, 1267 $ ABSTOL, M3, WA3, Z, LDU, V, RWORK, IWORK, 1268 $ IWORK( 5*N+1 ), IINFO ) 1269 IF( IINFO.NE.0 ) THEN 1270 WRITE( NOUNIT, FMT = 9999 )'ZHPEVX(N,V,' // UPLO // 1271 $ ')', IINFO, N, JTYPE, IOLDSD 1272 INFO = ABS( IINFO ) 1273 IF( IINFO.LT.0 ) THEN 1274 RETURN 1275 ELSE 1276 RESULT( NTEST ) = ULPINV 1277 GO TO 550 1278 END IF 1279 END IF 1280* 1281 IF( M3.EQ.0 .AND. N.GT.0 ) THEN 1282 RESULT( NTEST ) = ULPINV 1283 GO TO 550 1284 END IF 1285* 1286* Do test 24. 1287* 1288 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 1289 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 1290 IF( N.GT.0 ) THEN 1291 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 1292 ELSE 1293 TEMP3 = ZERO 1294 END IF 1295 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 1296 $ MAX( UNFL, TEMP3*ULP ) 1297* 1298 550 CONTINUE 1299* 1300* Call ZHBEVD and CHBEVX. 1301* 1302 IF( JTYPE.LE.7 ) THEN 1303 KD = 0 1304 ELSE IF( JTYPE.GE.8 .AND. JTYPE.LE.15 ) THEN 1305 KD = MAX( N-1, 0 ) 1306 ELSE 1307 KD = IHBW 1308 END IF 1309* 1310* Load array V with the upper or lower triangular part 1311* of the matrix in band form. 1312* 1313 IF( IUPLO.EQ.1 ) THEN 1314 DO 570 J = 1, N 1315 DO 560 I = MAX( 1, J-KD ), J 1316 V( KD+1+I-J, J ) = A( I, J ) 1317 560 CONTINUE 1318 570 CONTINUE 1319 ELSE 1320 DO 590 J = 1, N 1321 DO 580 I = J, MIN( N, J+KD ) 1322 V( 1+I-J, J ) = A( I, J ) 1323 580 CONTINUE 1324 590 CONTINUE 1325 END IF 1326* 1327 NTEST = NTEST + 1 1328 CALL ZHBEVD( 'V', UPLO, N, KD, V, LDU, D1, Z, LDU, WORK, 1329 $ LWEDC, RWORK, LRWEDC, IWORK, LIWEDC, IINFO ) 1330 IF( IINFO.NE.0 ) THEN 1331 WRITE( NOUNIT, FMT = 9998 )'ZHBEVD(V,' // UPLO // 1332 $ ')', IINFO, N, KD, JTYPE, IOLDSD 1333 INFO = ABS( IINFO ) 1334 IF( IINFO.LT.0 ) THEN 1335 RETURN 1336 ELSE 1337 RESULT( NTEST ) = ULPINV 1338 RESULT( NTEST+1 ) = ULPINV 1339 RESULT( NTEST+2 ) = ULPINV 1340 GO TO 650 1341 END IF 1342 END IF 1343* 1344* Do tests 25 and 26. 1345* 1346 CALL ZHET21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V, 1347 $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 1348* 1349 IF( IUPLO.EQ.1 ) THEN 1350 DO 610 J = 1, N 1351 DO 600 I = MAX( 1, J-KD ), J 1352 V( KD+1+I-J, J ) = A( I, J ) 1353 600 CONTINUE 1354 610 CONTINUE 1355 ELSE 1356 DO 630 J = 1, N 1357 DO 620 I = J, MIN( N, J+KD ) 1358 V( 1+I-J, J ) = A( I, J ) 1359 620 CONTINUE 1360 630 CONTINUE 1361 END IF 1362* 1363 NTEST = NTEST + 2 1364 CALL ZHBEVD( 'N', UPLO, N, KD, V, LDU, D3, Z, LDU, WORK, 1365 $ LWEDC, RWORK, LRWEDC, IWORK, LIWEDC, IINFO ) 1366 IF( IINFO.NE.0 ) THEN 1367 WRITE( NOUNIT, FMT = 9998 )'ZHBEVD(N,' // UPLO // 1368 $ ')', IINFO, N, KD, JTYPE, IOLDSD 1369 INFO = ABS( IINFO ) 1370 IF( IINFO.LT.0 ) THEN 1371 RETURN 1372 ELSE 1373 RESULT( NTEST ) = ULPINV 1374 GO TO 650 1375 END IF 1376 END IF 1377* 1378* Do test 27. 1379* 1380 TEMP1 = ZERO 1381 TEMP2 = ZERO 1382 DO 640 J = 1, N 1383 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 1384 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 1385 640 CONTINUE 1386 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 1387 $ ULP*MAX( TEMP1, TEMP2 ) ) 1388* 1389* Load array V with the upper or lower triangular part 1390* of the matrix in band form. 1391* 1392 650 CONTINUE 1393 IF( IUPLO.EQ.1 ) THEN 1394 DO 670 J = 1, N 1395 DO 660 I = MAX( 1, J-KD ), J 1396 V( KD+1+I-J, J ) = A( I, J ) 1397 660 CONTINUE 1398 670 CONTINUE 1399 ELSE 1400 DO 690 J = 1, N 1401 DO 680 I = J, MIN( N, J+KD ) 1402 V( 1+I-J, J ) = A( I, J ) 1403 680 CONTINUE 1404 690 CONTINUE 1405 END IF 1406* 1407 NTEST = NTEST + 1 1408 CALL ZHBEVX( 'V', 'A', UPLO, N, KD, V, LDU, U, LDU, VL, 1409 $ VU, IL, IU, ABSTOL, M, WA1, Z, LDU, WORK, 1410 $ RWORK, IWORK, IWORK( 5*N+1 ), IINFO ) 1411 IF( IINFO.NE.0 ) THEN 1412 WRITE( NOUNIT, FMT = 9999 )'ZHBEVX(V,A,' // UPLO // 1413 $ ')', IINFO, N, KD, JTYPE, IOLDSD 1414 INFO = ABS( IINFO ) 1415 IF( IINFO.LT.0 ) THEN 1416 RETURN 1417 ELSE 1418 RESULT( NTEST ) = ULPINV 1419 RESULT( NTEST+1 ) = ULPINV 1420 RESULT( NTEST+2 ) = ULPINV 1421 GO TO 750 1422 END IF 1423 END IF 1424* 1425* Do tests 28 and 29. 1426* 1427 CALL ZHET21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V, 1428 $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 1429* 1430 NTEST = NTEST + 2 1431* 1432 IF( IUPLO.EQ.1 ) THEN 1433 DO 710 J = 1, N 1434 DO 700 I = MAX( 1, J-KD ), J 1435 V( KD+1+I-J, J ) = A( I, J ) 1436 700 CONTINUE 1437 710 CONTINUE 1438 ELSE 1439 DO 730 J = 1, N 1440 DO 720 I = J, MIN( N, J+KD ) 1441 V( 1+I-J, J ) = A( I, J ) 1442 720 CONTINUE 1443 730 CONTINUE 1444 END IF 1445* 1446 CALL ZHBEVX( 'N', 'A', UPLO, N, KD, V, LDU, U, LDU, VL, 1447 $ VU, IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK, 1448 $ RWORK, IWORK, IWORK( 5*N+1 ), IINFO ) 1449 IF( IINFO.NE.0 ) THEN 1450 WRITE( NOUNIT, FMT = 9998 )'ZHBEVX(N,A,' // UPLO // 1451 $ ')', IINFO, N, KD, JTYPE, IOLDSD 1452 INFO = ABS( IINFO ) 1453 IF( IINFO.LT.0 ) THEN 1454 RETURN 1455 ELSE 1456 RESULT( NTEST ) = ULPINV 1457 GO TO 750 1458 END IF 1459 END IF 1460* 1461* Do test 30. 1462* 1463 TEMP1 = ZERO 1464 TEMP2 = ZERO 1465 DO 740 J = 1, N 1466 TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) ) 1467 TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) ) 1468 740 CONTINUE 1469 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 1470 $ ULP*MAX( TEMP1, TEMP2 ) ) 1471* 1472* Load array V with the upper or lower triangular part 1473* of the matrix in band form. 1474* 1475 750 CONTINUE 1476 NTEST = NTEST + 1 1477 IF( IUPLO.EQ.1 ) THEN 1478 DO 770 J = 1, N 1479 DO 760 I = MAX( 1, J-KD ), J 1480 V( KD+1+I-J, J ) = A( I, J ) 1481 760 CONTINUE 1482 770 CONTINUE 1483 ELSE 1484 DO 790 J = 1, N 1485 DO 780 I = J, MIN( N, J+KD ) 1486 V( 1+I-J, J ) = A( I, J ) 1487 780 CONTINUE 1488 790 CONTINUE 1489 END IF 1490* 1491 CALL ZHBEVX( 'V', 'I', UPLO, N, KD, V, LDU, U, LDU, VL, 1492 $ VU, IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK, 1493 $ RWORK, IWORK, IWORK( 5*N+1 ), IINFO ) 1494 IF( IINFO.NE.0 ) THEN 1495 WRITE( NOUNIT, FMT = 9998 )'ZHBEVX(V,I,' // UPLO // 1496 $ ')', IINFO, N, KD, JTYPE, IOLDSD 1497 INFO = ABS( IINFO ) 1498 IF( IINFO.LT.0 ) THEN 1499 RETURN 1500 ELSE 1501 RESULT( NTEST ) = ULPINV 1502 RESULT( NTEST+1 ) = ULPINV 1503 RESULT( NTEST+2 ) = ULPINV 1504 GO TO 840 1505 END IF 1506 END IF 1507* 1508* Do tests 31 and 32. 1509* 1510 CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 1511 $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 1512* 1513 NTEST = NTEST + 2 1514* 1515 IF( IUPLO.EQ.1 ) THEN 1516 DO 810 J = 1, N 1517 DO 800 I = MAX( 1, J-KD ), J 1518 V( KD+1+I-J, J ) = A( I, J ) 1519 800 CONTINUE 1520 810 CONTINUE 1521 ELSE 1522 DO 830 J = 1, N 1523 DO 820 I = J, MIN( N, J+KD ) 1524 V( 1+I-J, J ) = A( I, J ) 1525 820 CONTINUE 1526 830 CONTINUE 1527 END IF 1528 CALL ZHBEVX( 'N', 'I', UPLO, N, KD, V, LDU, U, LDU, VL, 1529 $ VU, IL, IU, ABSTOL, M3, WA3, Z, LDU, WORK, 1530 $ RWORK, IWORK, IWORK( 5*N+1 ), IINFO ) 1531 IF( IINFO.NE.0 ) THEN 1532 WRITE( NOUNIT, FMT = 9998 )'ZHBEVX(N,I,' // UPLO // 1533 $ ')', IINFO, N, KD, JTYPE, IOLDSD 1534 INFO = ABS( IINFO ) 1535 IF( IINFO.LT.0 ) THEN 1536 RETURN 1537 ELSE 1538 RESULT( NTEST ) = ULPINV 1539 GO TO 840 1540 END IF 1541 END IF 1542* 1543* Do test 33. 1544* 1545 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 1546 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 1547 IF( N.GT.0 ) THEN 1548 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 1549 ELSE 1550 TEMP3 = ZERO 1551 END IF 1552 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 1553 $ MAX( UNFL, TEMP3*ULP ) 1554* 1555* Load array V with the upper or lower triangular part 1556* of the matrix in band form. 1557* 1558 840 CONTINUE 1559 NTEST = NTEST + 1 1560 IF( IUPLO.EQ.1 ) THEN 1561 DO 860 J = 1, N 1562 DO 850 I = MAX( 1, J-KD ), J 1563 V( KD+1+I-J, J ) = A( I, J ) 1564 850 CONTINUE 1565 860 CONTINUE 1566 ELSE 1567 DO 880 J = 1, N 1568 DO 870 I = J, MIN( N, J+KD ) 1569 V( 1+I-J, J ) = A( I, J ) 1570 870 CONTINUE 1571 880 CONTINUE 1572 END IF 1573 CALL ZHBEVX( 'V', 'V', UPLO, N, KD, V, LDU, U, LDU, VL, 1574 $ VU, IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK, 1575 $ RWORK, IWORK, IWORK( 5*N+1 ), IINFO ) 1576 IF( IINFO.NE.0 ) THEN 1577 WRITE( NOUNIT, FMT = 9998 )'ZHBEVX(V,V,' // UPLO // 1578 $ ')', IINFO, N, KD, JTYPE, IOLDSD 1579 INFO = ABS( IINFO ) 1580 IF( IINFO.LT.0 ) THEN 1581 RETURN 1582 ELSE 1583 RESULT( NTEST ) = ULPINV 1584 RESULT( NTEST+1 ) = ULPINV 1585 RESULT( NTEST+2 ) = ULPINV 1586 GO TO 930 1587 END IF 1588 END IF 1589* 1590* Do tests 34 and 35. 1591* 1592 CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 1593 $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 1594* 1595 NTEST = NTEST + 2 1596* 1597 IF( IUPLO.EQ.1 ) THEN 1598 DO 900 J = 1, N 1599 DO 890 I = MAX( 1, J-KD ), J 1600 V( KD+1+I-J, J ) = A( I, J ) 1601 890 CONTINUE 1602 900 CONTINUE 1603 ELSE 1604 DO 920 J = 1, N 1605 DO 910 I = J, MIN( N, J+KD ) 1606 V( 1+I-J, J ) = A( I, J ) 1607 910 CONTINUE 1608 920 CONTINUE 1609 END IF 1610 CALL ZHBEVX( 'N', 'V', UPLO, N, KD, V, LDU, U, LDU, VL, 1611 $ VU, IL, IU, ABSTOL, M3, WA3, Z, LDU, WORK, 1612 $ RWORK, IWORK, IWORK( 5*N+1 ), IINFO ) 1613 IF( IINFO.NE.0 ) THEN 1614 WRITE( NOUNIT, FMT = 9998 )'ZHBEVX(N,V,' // UPLO // 1615 $ ')', IINFO, N, KD, JTYPE, IOLDSD 1616 INFO = ABS( IINFO ) 1617 IF( IINFO.LT.0 ) THEN 1618 RETURN 1619 ELSE 1620 RESULT( NTEST ) = ULPINV 1621 GO TO 930 1622 END IF 1623 END IF 1624* 1625 IF( M3.EQ.0 .AND. N.GT.0 ) THEN 1626 RESULT( NTEST ) = ULPINV 1627 GO TO 930 1628 END IF 1629* 1630* Do test 36. 1631* 1632 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 1633 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 1634 IF( N.GT.0 ) THEN 1635 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 1636 ELSE 1637 TEMP3 = ZERO 1638 END IF 1639 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 1640 $ MAX( UNFL, TEMP3*ULP ) 1641* 1642 930 CONTINUE 1643* 1644* Call ZHEEV 1645* 1646 CALL ZLACPY( ' ', N, N, A, LDA, V, LDU ) 1647* 1648 NTEST = NTEST + 1 1649 CALL ZHEEV( 'V', UPLO, N, A, LDU, D1, WORK, LWORK, RWORK, 1650 $ IINFO ) 1651 IF( IINFO.NE.0 ) THEN 1652 WRITE( NOUNIT, FMT = 9999 )'ZHEEV(V,' // UPLO // ')', 1653 $ IINFO, N, JTYPE, IOLDSD 1654 INFO = ABS( IINFO ) 1655 IF( IINFO.LT.0 ) THEN 1656 RETURN 1657 ELSE 1658 RESULT( NTEST ) = ULPINV 1659 RESULT( NTEST+1 ) = ULPINV 1660 RESULT( NTEST+2 ) = ULPINV 1661 GO TO 950 1662 END IF 1663 END IF 1664* 1665* Do tests 37 and 38 1666* 1667 CALL ZHET21( 1, UPLO, N, 0, V, LDU, D1, D2, A, LDU, Z, 1668 $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 1669* 1670 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 1671* 1672 NTEST = NTEST + 2 1673 CALL ZHEEV( 'N', UPLO, N, A, LDU, D3, WORK, LWORK, RWORK, 1674 $ IINFO ) 1675 IF( IINFO.NE.0 ) THEN 1676 WRITE( NOUNIT, FMT = 9999 )'ZHEEV(N,' // UPLO // ')', 1677 $ IINFO, N, JTYPE, IOLDSD 1678 INFO = ABS( IINFO ) 1679 IF( IINFO.LT.0 ) THEN 1680 RETURN 1681 ELSE 1682 RESULT( NTEST ) = ULPINV 1683 GO TO 950 1684 END IF 1685 END IF 1686* 1687* Do test 39 1688* 1689 TEMP1 = ZERO 1690 TEMP2 = ZERO 1691 DO 940 J = 1, N 1692 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 1693 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 1694 940 CONTINUE 1695 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 1696 $ ULP*MAX( TEMP1, TEMP2 ) ) 1697* 1698 950 CONTINUE 1699* 1700 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 1701* 1702* Call ZHPEV 1703* 1704* Load array WORK with the upper or lower triangular 1705* part of the matrix in packed form. 1706* 1707 IF( IUPLO.EQ.1 ) THEN 1708 INDX = 1 1709 DO 970 J = 1, N 1710 DO 960 I = 1, J 1711 WORK( INDX ) = A( I, J ) 1712 INDX = INDX + 1 1713 960 CONTINUE 1714 970 CONTINUE 1715 ELSE 1716 INDX = 1 1717 DO 990 J = 1, N 1718 DO 980 I = J, N 1719 WORK( INDX ) = A( I, J ) 1720 INDX = INDX + 1 1721 980 CONTINUE 1722 990 CONTINUE 1723 END IF 1724* 1725 NTEST = NTEST + 1 1726 INDWRK = N*( N+1 ) / 2 + 1 1727 CALL ZHPEV( 'V', UPLO, N, WORK, D1, Z, LDU, 1728 $ WORK( INDWRK ), RWORK, IINFO ) 1729 IF( IINFO.NE.0 ) THEN 1730 WRITE( NOUNIT, FMT = 9999 )'ZHPEV(V,' // UPLO // ')', 1731 $ IINFO, N, JTYPE, IOLDSD 1732 INFO = ABS( IINFO ) 1733 IF( IINFO.LT.0 ) THEN 1734 RETURN 1735 ELSE 1736 RESULT( NTEST ) = ULPINV 1737 RESULT( NTEST+1 ) = ULPINV 1738 RESULT( NTEST+2 ) = ULPINV 1739 GO TO 1050 1740 END IF 1741 END IF 1742* 1743* Do tests 40 and 41. 1744* 1745 CALL ZHET21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V, 1746 $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 1747* 1748 IF( IUPLO.EQ.1 ) THEN 1749 INDX = 1 1750 DO 1010 J = 1, N 1751 DO 1000 I = 1, J 1752 WORK( INDX ) = A( I, J ) 1753 INDX = INDX + 1 1754 1000 CONTINUE 1755 1010 CONTINUE 1756 ELSE 1757 INDX = 1 1758 DO 1030 J = 1, N 1759 DO 1020 I = J, N 1760 WORK( INDX ) = A( I, J ) 1761 INDX = INDX + 1 1762 1020 CONTINUE 1763 1030 CONTINUE 1764 END IF 1765* 1766 NTEST = NTEST + 2 1767 INDWRK = N*( N+1 ) / 2 + 1 1768 CALL ZHPEV( 'N', UPLO, N, WORK, D3, Z, LDU, 1769 $ WORK( INDWRK ), RWORK, IINFO ) 1770 IF( IINFO.NE.0 ) THEN 1771 WRITE( NOUNIT, FMT = 9999 )'ZHPEV(N,' // UPLO // ')', 1772 $ IINFO, N, JTYPE, IOLDSD 1773 INFO = ABS( IINFO ) 1774 IF( IINFO.LT.0 ) THEN 1775 RETURN 1776 ELSE 1777 RESULT( NTEST ) = ULPINV 1778 GO TO 1050 1779 END IF 1780 END IF 1781* 1782* Do test 42 1783* 1784 TEMP1 = ZERO 1785 TEMP2 = ZERO 1786 DO 1040 J = 1, N 1787 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 1788 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 1789 1040 CONTINUE 1790 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 1791 $ ULP*MAX( TEMP1, TEMP2 ) ) 1792* 1793 1050 CONTINUE 1794* 1795* Call ZHBEV 1796* 1797 IF( JTYPE.LE.7 ) THEN 1798 KD = 0 1799 ELSE IF( JTYPE.GE.8 .AND. JTYPE.LE.15 ) THEN 1800 KD = MAX( N-1, 0 ) 1801 ELSE 1802 KD = IHBW 1803 END IF 1804* 1805* Load array V with the upper or lower triangular part 1806* of the matrix in band form. 1807* 1808 IF( IUPLO.EQ.1 ) THEN 1809 DO 1070 J = 1, N 1810 DO 1060 I = MAX( 1, J-KD ), J 1811 V( KD+1+I-J, J ) = A( I, J ) 1812 1060 CONTINUE 1813 1070 CONTINUE 1814 ELSE 1815 DO 1090 J = 1, N 1816 DO 1080 I = J, MIN( N, J+KD ) 1817 V( 1+I-J, J ) = A( I, J ) 1818 1080 CONTINUE 1819 1090 CONTINUE 1820 END IF 1821* 1822 NTEST = NTEST + 1 1823 CALL ZHBEV( 'V', UPLO, N, KD, V, LDU, D1, Z, LDU, WORK, 1824 $ RWORK, IINFO ) 1825 IF( IINFO.NE.0 ) THEN 1826 WRITE( NOUNIT, FMT = 9998 )'ZHBEV(V,' // UPLO // ')', 1827 $ IINFO, N, KD, JTYPE, IOLDSD 1828 INFO = ABS( IINFO ) 1829 IF( IINFO.LT.0 ) THEN 1830 RETURN 1831 ELSE 1832 RESULT( NTEST ) = ULPINV 1833 RESULT( NTEST+1 ) = ULPINV 1834 RESULT( NTEST+2 ) = ULPINV 1835 GO TO 1140 1836 END IF 1837 END IF 1838* 1839* Do tests 43 and 44. 1840* 1841 CALL ZHET21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V, 1842 $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 1843* 1844 IF( IUPLO.EQ.1 ) THEN 1845 DO 1110 J = 1, N 1846 DO 1100 I = MAX( 1, J-KD ), J 1847 V( KD+1+I-J, J ) = A( I, J ) 1848 1100 CONTINUE 1849 1110 CONTINUE 1850 ELSE 1851 DO 1130 J = 1, N 1852 DO 1120 I = J, MIN( N, J+KD ) 1853 V( 1+I-J, J ) = A( I, J ) 1854 1120 CONTINUE 1855 1130 CONTINUE 1856 END IF 1857* 1858 NTEST = NTEST + 2 1859 CALL ZHBEV( 'N', UPLO, N, KD, V, LDU, D3, Z, LDU, WORK, 1860 $ RWORK, IINFO ) 1861 IF( IINFO.NE.0 ) THEN 1862 WRITE( NOUNIT, FMT = 9998 )'ZHBEV(N,' // UPLO // ')', 1863 $ IINFO, N, KD, JTYPE, IOLDSD 1864 INFO = ABS( IINFO ) 1865 IF( IINFO.LT.0 ) THEN 1866 RETURN 1867 ELSE 1868 RESULT( NTEST ) = ULPINV 1869 GO TO 1140 1870 END IF 1871 END IF 1872* 1873 1140 CONTINUE 1874* 1875* Do test 45. 1876* 1877 TEMP1 = ZERO 1878 TEMP2 = ZERO 1879 DO 1150 J = 1, N 1880 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 1881 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 1882 1150 CONTINUE 1883 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 1884 $ ULP*MAX( TEMP1, TEMP2 ) ) 1885* 1886 CALL ZLACPY( ' ', N, N, A, LDA, V, LDU ) 1887 NTEST = NTEST + 1 1888 CALL ZHEEVR( 'V', 'A', UPLO, N, A, LDU, VL, VU, IL, IU, 1889 $ ABSTOL, M, WA1, Z, LDU, IWORK, WORK, LWORK, 1890 $ RWORK, LRWORK, IWORK( 2*N+1 ), LIWORK-2*N, 1891 $ IINFO ) 1892 IF( IINFO.NE.0 ) THEN 1893 WRITE( NOUNIT, FMT = 9999 )'ZHEEVR(V,A,' // UPLO // 1894 $ ')', IINFO, N, JTYPE, IOLDSD 1895 INFO = ABS( IINFO ) 1896 IF( IINFO.LT.0 ) THEN 1897 RETURN 1898 ELSE 1899 RESULT( NTEST ) = ULPINV 1900 RESULT( NTEST+1 ) = ULPINV 1901 RESULT( NTEST+2 ) = ULPINV 1902 GO TO 1170 1903 END IF 1904 END IF 1905* 1906* Do tests 45 and 46 (or ... ) 1907* 1908 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 1909* 1910 CALL ZHET21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V, 1911 $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 1912* 1913 NTEST = NTEST + 2 1914 CALL ZHEEVR( 'N', 'A', UPLO, N, A, LDU, VL, VU, IL, IU, 1915 $ ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK, 1916 $ RWORK, LRWORK, IWORK( 2*N+1 ), LIWORK-2*N, 1917 $ IINFO ) 1918 IF( IINFO.NE.0 ) THEN 1919 WRITE( NOUNIT, FMT = 9999 )'ZHEEVR(N,A,' // UPLO // 1920 $ ')', IINFO, N, JTYPE, IOLDSD 1921 INFO = ABS( IINFO ) 1922 IF( IINFO.LT.0 ) THEN 1923 RETURN 1924 ELSE 1925 RESULT( NTEST ) = ULPINV 1926 GO TO 1170 1927 END IF 1928 END IF 1929* 1930* Do test 47 (or ... ) 1931* 1932 TEMP1 = ZERO 1933 TEMP2 = ZERO 1934 DO 1160 J = 1, N 1935 TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) ) 1936 TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) ) 1937 1160 CONTINUE 1938 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 1939 $ ULP*MAX( TEMP1, TEMP2 ) ) 1940* 1941 1170 CONTINUE 1942* 1943 NTEST = NTEST + 1 1944 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 1945 CALL ZHEEVR( 'V', 'I', UPLO, N, A, LDU, VL, VU, IL, IU, 1946 $ ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK, 1947 $ RWORK, LRWORK, IWORK( 2*N+1 ), LIWORK-2*N, 1948 $ IINFO ) 1949 IF( IINFO.NE.0 ) THEN 1950 WRITE( NOUNIT, FMT = 9999 )'ZHEEVR(V,I,' // UPLO // 1951 $ ')', IINFO, N, JTYPE, IOLDSD 1952 INFO = ABS( IINFO ) 1953 IF( IINFO.LT.0 ) THEN 1954 RETURN 1955 ELSE 1956 RESULT( NTEST ) = ULPINV 1957 RESULT( NTEST+1 ) = ULPINV 1958 RESULT( NTEST+2 ) = ULPINV 1959 GO TO 1180 1960 END IF 1961 END IF 1962* 1963* Do tests 48 and 49 (or +??) 1964* 1965 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 1966* 1967 CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 1968 $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 1969* 1970 NTEST = NTEST + 2 1971 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 1972 CALL ZHEEVR( 'N', 'I', UPLO, N, A, LDU, VL, VU, IL, IU, 1973 $ ABSTOL, M3, WA3, Z, LDU, IWORK, WORK, LWORK, 1974 $ RWORK, LRWORK, IWORK( 2*N+1 ), LIWORK-2*N, 1975 $ IINFO ) 1976 IF( IINFO.NE.0 ) THEN 1977 WRITE( NOUNIT, FMT = 9999 )'ZHEEVR(N,I,' // UPLO // 1978 $ ')', IINFO, N, JTYPE, IOLDSD 1979 INFO = ABS( IINFO ) 1980 IF( IINFO.LT.0 ) THEN 1981 RETURN 1982 ELSE 1983 RESULT( NTEST ) = ULPINV 1984 GO TO 1180 1985 END IF 1986 END IF 1987* 1988* Do test 50 (or +??) 1989* 1990 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 1991 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 1992 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 1993 $ MAX( UNFL, ULP*TEMP3 ) 1994 1180 CONTINUE 1995* 1996 NTEST = NTEST + 1 1997 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 1998 CALL ZHEEVR( 'V', 'V', UPLO, N, A, LDU, VL, VU, IL, IU, 1999 $ ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK, 2000 $ RWORK, LRWORK, IWORK( 2*N+1 ), LIWORK-2*N, 2001 $ IINFO ) 2002 IF( IINFO.NE.0 ) THEN 2003 WRITE( NOUNIT, FMT = 9999 )'ZHEEVR(V,V,' // UPLO // 2004 $ ')', IINFO, N, JTYPE, IOLDSD 2005 INFO = ABS( IINFO ) 2006 IF( IINFO.LT.0 ) THEN 2007 RETURN 2008 ELSE 2009 RESULT( NTEST ) = ULPINV 2010 RESULT( NTEST+1 ) = ULPINV 2011 RESULT( NTEST+2 ) = ULPINV 2012 GO TO 1190 2013 END IF 2014 END IF 2015* 2016* Do tests 51 and 52 (or +??) 2017* 2018 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 2019* 2020 CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 2021 $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 2022* 2023 NTEST = NTEST + 2 2024 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 2025 CALL ZHEEVR( 'N', 'V', UPLO, N, A, LDU, VL, VU, IL, IU, 2026 $ ABSTOL, M3, WA3, Z, LDU, IWORK, WORK, LWORK, 2027 $ RWORK, LRWORK, IWORK( 2*N+1 ), LIWORK-2*N, 2028 $ IINFO ) 2029 IF( IINFO.NE.0 ) THEN 2030 WRITE( NOUNIT, FMT = 9999 )'ZHEEVR(N,V,' // UPLO // 2031 $ ')', IINFO, N, JTYPE, IOLDSD 2032 INFO = ABS( IINFO ) 2033 IF( IINFO.LT.0 ) THEN 2034 RETURN 2035 ELSE 2036 RESULT( NTEST ) = ULPINV 2037 GO TO 1190 2038 END IF 2039 END IF 2040* 2041 IF( M3.EQ.0 .AND. N.GT.0 ) THEN 2042 RESULT( NTEST ) = ULPINV 2043 GO TO 1190 2044 END IF 2045* 2046* Do test 52 (or +??) 2047* 2048 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 2049 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 2050 IF( N.GT.0 ) THEN 2051 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 2052 ELSE 2053 TEMP3 = ZERO 2054 END IF 2055 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 2056 $ MAX( UNFL, TEMP3*ULP ) 2057* 2058 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 2059* 2060* 2061* 2062* 2063* Load array V with the upper or lower triangular part 2064* of the matrix in band form. 2065* 2066 1190 CONTINUE 2067* 2068 1200 CONTINUE 2069* 2070* End of Loop -- Check for RESULT(j) > THRESH 2071* 2072 NTESTT = NTESTT + NTEST 2073 CALL DLAFTS( 'ZST', N, N, JTYPE, NTEST, RESULT, IOLDSD, 2074 $ THRESH, NOUNIT, NERRS ) 2075* 2076 1210 CONTINUE 2077 1220 CONTINUE 2078* 2079* Summary 2080* 2081 CALL ALASVM( 'ZST', NOUNIT, NERRS, NTESTT, 0 ) 2082* 2083 9999 FORMAT( ' ZDRVST: ', A, ' returned INFO=', I6, / 9X, 'N=', I6, 2084 $ ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' ) 2085 9998 FORMAT( ' ZDRVST: ', A, ' returned INFO=', I6, / 9X, 'N=', I6, 2086 $ ', KD=', I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, 2087 $ ')' ) 2088* 2089 RETURN 2090* 2091* End of ZDRVST 2092* 2093 END 2094