1*> \brief \b ZDRVST2STG 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 ZDRVST2STG( 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*> ZDRVST2STG 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 ZDRVST2STG 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*> ZDRVST2STG 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, ZDRVST2STG 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 ZDRVST2STG 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*> \ingroup complex16_eig 332* 333* ===================================================================== 334 SUBROUTINE ZDRVST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, 335 $ NOUNIT, A, LDA, D1, D2, D3, WA1, WA2, WA3, U, 336 $ LDU, V, TAU, Z, WORK, LWORK, RWORK, LRWORK, 337 $ IWORK, LIWORK, RESULT, INFO ) 338* 339* -- LAPACK test routine -- 340* -- LAPACK is a software package provided by Univ. of Tennessee, -- 341* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 342* 343* .. Scalar Arguments .. 344 INTEGER INFO, LDA, LDU, LIWORK, LRWORK, LWORK, NOUNIT, 345 $ NSIZES, NTYPES 346 DOUBLE PRECISION THRESH 347* .. 348* .. Array Arguments .. 349 LOGICAL DOTYPE( * ) 350 INTEGER ISEED( 4 ), IWORK( * ), NN( * ) 351 DOUBLE PRECISION D1( * ), D2( * ), D3( * ), RESULT( * ), 352 $ RWORK( * ), WA1( * ), WA2( * ), WA3( * ) 353 COMPLEX*16 A( LDA, * ), TAU( * ), U( LDU, * ), 354 $ V( LDU, * ), WORK( * ), Z( LDU, * ) 355* .. 356* 357* ===================================================================== 358* 359* 360* .. Parameters .. 361 DOUBLE PRECISION ZERO, ONE, TWO, TEN 362 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0, 363 $ TEN = 10.0D+0 ) 364 DOUBLE PRECISION HALF 365 PARAMETER ( HALF = ONE / TWO ) 366 COMPLEX*16 CZERO, CONE 367 PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ), 368 $ CONE = ( 1.0D+0, 0.0D+0 ) ) 369 INTEGER MAXTYP 370 PARAMETER ( MAXTYP = 18 ) 371* .. 372* .. Local Scalars .. 373 LOGICAL BADNN 374 CHARACTER UPLO 375 INTEGER I, IDIAG, IHBW, IINFO, IL, IMODE, INDWRK, INDX, 376 $ IROW, ITEMP, ITYPE, IU, IUPLO, J, J1, J2, JCOL, 377 $ JSIZE, JTYPE, KD, LGN, LIWEDC, LRWEDC, LWEDC, 378 $ M, M2, M3, MTYPES, N, NERRS, NMATS, NMAX, 379 $ NTEST, NTESTT 380 DOUBLE PRECISION ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL, 381 $ RTUNFL, TEMP1, TEMP2, TEMP3, ULP, ULPINV, UNFL, 382 $ VL, VU 383* .. 384* .. Local Arrays .. 385 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ), 386 $ ISEED3( 4 ), KMAGN( MAXTYP ), KMODE( MAXTYP ), 387 $ KTYPE( MAXTYP ) 388* .. 389* .. External Functions .. 390 DOUBLE PRECISION DLAMCH, DLARND, DSXT1 391 EXTERNAL DLAMCH, DLARND, DSXT1 392* .. 393* .. External Subroutines .. 394 EXTERNAL ALASVM, DLABAD, DLAFTS, XERBLA, ZHBEV, ZHBEVD, 395 $ ZHBEVX, ZHEEV, ZHEEVD, ZHEEVR, ZHEEVX, ZHET21, 396 $ ZHET22, ZHPEV, ZHPEVD, ZHPEVX, ZLACPY, ZLASET, 397 $ ZHEEVD_2STAGE, ZHEEVR_2STAGE, ZHEEVX_2STAGE, 398 $ ZHEEV_2STAGE, ZHBEV_2STAGE, ZHBEVD_2STAGE, 399 $ ZHBEVX_2STAGE, ZHETRD_2STAGE, ZLATMR, ZLATMS 400* .. 401* .. Intrinsic Functions .. 402 INTRINSIC ABS, DBLE, INT, LOG, MAX, MIN, SQRT 403* .. 404* .. Data statements .. 405 DATA KTYPE / 1, 2, 5*4, 5*5, 3*8, 3*9 / 406 DATA KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1, 407 $ 2, 3, 1, 2, 3 / 408 DATA KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0, 409 $ 0, 0, 4, 4, 4 / 410* .. 411* .. Executable Statements .. 412* 413* 1) Check for errors 414* 415 NTESTT = 0 416 INFO = 0 417* 418 BADNN = .FALSE. 419 NMAX = 1 420 DO 10 J = 1, NSIZES 421 NMAX = MAX( NMAX, NN( J ) ) 422 IF( NN( J ).LT.0 ) 423 $ BADNN = .TRUE. 424 10 CONTINUE 425* 426* Check for errors 427* 428 IF( NSIZES.LT.0 ) THEN 429 INFO = -1 430 ELSE IF( BADNN ) THEN 431 INFO = -2 432 ELSE IF( NTYPES.LT.0 ) THEN 433 INFO = -3 434 ELSE IF( LDA.LT.NMAX ) THEN 435 INFO = -9 436 ELSE IF( LDU.LT.NMAX ) THEN 437 INFO = -16 438 ELSE IF( 2*MAX( 2, NMAX )**2.GT.LWORK ) THEN 439 INFO = -22 440 END IF 441* 442 IF( INFO.NE.0 ) THEN 443 CALL XERBLA( 'ZDRVST2STG', -INFO ) 444 RETURN 445 END IF 446* 447* Quick return if nothing to do 448* 449 IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 ) 450 $ RETURN 451* 452* More Important constants 453* 454 UNFL = DLAMCH( 'Safe minimum' ) 455 OVFL = DLAMCH( 'Overflow' ) 456 CALL DLABAD( UNFL, OVFL ) 457 ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) 458 ULPINV = ONE / ULP 459 RTUNFL = SQRT( UNFL ) 460 RTOVFL = SQRT( OVFL ) 461* 462* Loop over sizes, types 463* 464 DO 20 I = 1, 4 465 ISEED2( I ) = ISEED( I ) 466 ISEED3( I ) = ISEED( I ) 467 20 CONTINUE 468* 469 NERRS = 0 470 NMATS = 0 471* 472 DO 1220 JSIZE = 1, NSIZES 473 N = NN( JSIZE ) 474 IF( N.GT.0 ) THEN 475 LGN = INT( LOG( DBLE( N ) ) / LOG( TWO ) ) 476 IF( 2**LGN.LT.N ) 477 $ LGN = LGN + 1 478 IF( 2**LGN.LT.N ) 479 $ LGN = LGN + 1 480 LWEDC = MAX( 2*N+N*N, 2*N*N ) 481 LRWEDC = 1 + 4*N + 2*N*LGN + 3*N**2 482 LIWEDC = 3 + 5*N 483 ELSE 484 LWEDC = 2 485 LRWEDC = 8 486 LIWEDC = 8 487 END IF 488 ANINV = ONE / DBLE( MAX( 1, N ) ) 489* 490 IF( NSIZES.NE.1 ) THEN 491 MTYPES = MIN( MAXTYP, NTYPES ) 492 ELSE 493 MTYPES = MIN( MAXTYP+1, NTYPES ) 494 END IF 495* 496 DO 1210 JTYPE = 1, MTYPES 497 IF( .NOT.DOTYPE( JTYPE ) ) 498 $ GO TO 1210 499 NMATS = NMATS + 1 500 NTEST = 0 501* 502 DO 30 J = 1, 4 503 IOLDSD( J ) = ISEED( J ) 504 30 CONTINUE 505* 506* 2) Compute "A" 507* 508* Control parameters: 509* 510* KMAGN KMODE KTYPE 511* =1 O(1) clustered 1 zero 512* =2 large clustered 2 identity 513* =3 small exponential (none) 514* =4 arithmetic diagonal, (w/ eigenvalues) 515* =5 random log Hermitian, w/ eigenvalues 516* =6 random (none) 517* =7 random diagonal 518* =8 random Hermitian 519* =9 band Hermitian, w/ eigenvalues 520* 521 IF( MTYPES.GT.MAXTYP ) 522 $ GO TO 110 523* 524 ITYPE = KTYPE( JTYPE ) 525 IMODE = KMODE( JTYPE ) 526* 527* Compute norm 528* 529 GO TO ( 40, 50, 60 )KMAGN( JTYPE ) 530* 531 40 CONTINUE 532 ANORM = ONE 533 GO TO 70 534* 535 50 CONTINUE 536 ANORM = ( RTOVFL*ULP )*ANINV 537 GO TO 70 538* 539 60 CONTINUE 540 ANORM = RTUNFL*N*ULPINV 541 GO TO 70 542* 543 70 CONTINUE 544* 545 CALL ZLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA ) 546 IINFO = 0 547 COND = ULPINV 548* 549* Special Matrices -- Identity & Jordan block 550* 551* Zero 552* 553 IF( ITYPE.EQ.1 ) THEN 554 IINFO = 0 555* 556 ELSE IF( ITYPE.EQ.2 ) THEN 557* 558* Identity 559* 560 DO 80 JCOL = 1, N 561 A( JCOL, JCOL ) = ANORM 562 80 CONTINUE 563* 564 ELSE IF( ITYPE.EQ.4 ) THEN 565* 566* Diagonal Matrix, [Eigen]values Specified 567* 568 CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND, 569 $ ANORM, 0, 0, 'N', A, LDA, WORK, IINFO ) 570* 571 ELSE IF( ITYPE.EQ.5 ) THEN 572* 573* Hermitian, eigenvalues specified 574* 575 CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND, 576 $ ANORM, N, N, 'N', A, LDA, WORK, IINFO ) 577* 578 ELSE IF( ITYPE.EQ.7 ) THEN 579* 580* Diagonal, random eigenvalues 581* 582 CALL ZLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE, 583 $ 'T', 'N', WORK( N+1 ), 1, ONE, 584 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0, 585 $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO ) 586* 587 ELSE IF( ITYPE.EQ.8 ) THEN 588* 589* Hermitian, random eigenvalues 590* 591 CALL ZLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE, 592 $ 'T', 'N', WORK( N+1 ), 1, ONE, 593 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N, 594 $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO ) 595* 596 ELSE IF( ITYPE.EQ.9 ) THEN 597* 598* Hermitian banded, eigenvalues specified 599* 600 IHBW = INT( ( N-1 )*DLARND( 1, ISEED3 ) ) 601 CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND, 602 $ ANORM, IHBW, IHBW, 'Z', U, LDU, WORK, 603 $ IINFO ) 604* 605* Store as dense matrix for most routines. 606* 607 CALL ZLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA ) 608 DO 100 IDIAG = -IHBW, IHBW 609 IROW = IHBW - IDIAG + 1 610 J1 = MAX( 1, IDIAG+1 ) 611 J2 = MIN( N, N+IDIAG ) 612 DO 90 J = J1, J2 613 I = J - IDIAG 614 A( I, J ) = U( IROW, J ) 615 90 CONTINUE 616 100 CONTINUE 617 ELSE 618 IINFO = 1 619 END IF 620* 621 IF( IINFO.NE.0 ) THEN 622 WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE, 623 $ IOLDSD 624 INFO = ABS( IINFO ) 625 RETURN 626 END IF 627* 628 110 CONTINUE 629* 630 ABSTOL = UNFL + UNFL 631 IF( N.LE.1 ) THEN 632 IL = 1 633 IU = N 634 ELSE 635 IL = 1 + INT( ( N-1 )*DLARND( 1, ISEED2 ) ) 636 IU = 1 + INT( ( N-1 )*DLARND( 1, ISEED2 ) ) 637 IF( IL.GT.IU ) THEN 638 ITEMP = IL 639 IL = IU 640 IU = ITEMP 641 END IF 642 END IF 643* 644* Perform tests storing upper or lower triangular 645* part of matrix. 646* 647 DO 1200 IUPLO = 0, 1 648 IF( IUPLO.EQ.0 ) THEN 649 UPLO = 'L' 650 ELSE 651 UPLO = 'U' 652 END IF 653* 654* Call ZHEEVD and CHEEVX. 655* 656 CALL ZLACPY( ' ', N, N, A, LDA, V, LDU ) 657* 658 NTEST = NTEST + 1 659 CALL ZHEEVD( 'V', UPLO, N, A, LDU, D1, WORK, LWEDC, 660 $ RWORK, LRWEDC, IWORK, LIWEDC, IINFO ) 661 IF( IINFO.NE.0 ) THEN 662 WRITE( NOUNIT, FMT = 9999 )'ZHEEVD(V,' // UPLO // 663 $ ')', IINFO, N, JTYPE, IOLDSD 664 INFO = ABS( IINFO ) 665 IF( IINFO.LT.0 ) THEN 666 RETURN 667 ELSE 668 RESULT( NTEST ) = ULPINV 669 RESULT( NTEST+1 ) = ULPINV 670 RESULT( NTEST+2 ) = ULPINV 671 GO TO 130 672 END IF 673 END IF 674* 675* Do tests 1 and 2. 676* 677 CALL ZHET21( 1, UPLO, N, 0, V, LDU, D1, D2, A, LDU, Z, 678 $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 679* 680 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 681* 682 NTEST = NTEST + 2 683 CALL ZHEEVD_2STAGE( 'N', UPLO, N, A, LDU, D3, WORK, 684 $ LWORK, RWORK, LRWEDC, IWORK, LIWEDC, IINFO ) 685 IF( IINFO.NE.0 ) THEN 686 WRITE( NOUNIT, FMT = 9999 ) 687 $ 'ZHEEVD_2STAGE(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_2STAGE( 'N', 'A', UPLO, N, A, LDU, VL, VU, 762 $ IL, IU, ABSTOL, M2, WA2, Z, LDU, 763 $ WORK, LWORK, RWORK, IWORK, 764 $ IWORK( 5*N+1 ), IINFO ) 765 IF( IINFO.NE.0 ) THEN 766 WRITE( NOUNIT, FMT = 9999 ) 767 $ 'ZHEEVX_2STAGE(N,A,' // UPLO // 768 $ ')', IINFO, N, JTYPE, IOLDSD 769 INFO = ABS( IINFO ) 770 IF( IINFO.LT.0 ) THEN 771 RETURN 772 ELSE 773 RESULT( NTEST ) = ULPINV 774 GO TO 150 775 END IF 776 END IF 777* 778* Do test 6. 779* 780 TEMP1 = ZERO 781 TEMP2 = ZERO 782 DO 140 J = 1, N 783 TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) ) 784 TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) ) 785 140 CONTINUE 786 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 787 $ ULP*MAX( TEMP1, TEMP2 ) ) 788* 789 150 CONTINUE 790 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 791* 792 NTEST = NTEST + 1 793* 794 CALL ZHEEVX( 'V', 'I', UPLO, N, A, LDU, VL, VU, IL, IU, 795 $ ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, RWORK, 796 $ IWORK, IWORK( 5*N+1 ), IINFO ) 797 IF( IINFO.NE.0 ) THEN 798 WRITE( NOUNIT, FMT = 9999 )'ZHEEVX(V,I,' // UPLO // 799 $ ')', IINFO, N, JTYPE, IOLDSD 800 INFO = ABS( IINFO ) 801 IF( IINFO.LT.0 ) THEN 802 RETURN 803 ELSE 804 RESULT( NTEST ) = ULPINV 805 GO TO 160 806 END IF 807 END IF 808* 809* Do tests 7 and 8. 810* 811 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 812* 813 CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 814 $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 815* 816 NTEST = NTEST + 2 817* 818 CALL ZHEEVX_2STAGE( 'N', 'I', UPLO, N, A, LDU, VL, VU, 819 $ IL, IU, ABSTOL, M3, WA3, Z, LDU, 820 $ WORK, LWORK, RWORK, IWORK, 821 $ IWORK( 5*N+1 ), IINFO ) 822 IF( IINFO.NE.0 ) THEN 823 WRITE( NOUNIT, FMT = 9999 ) 824 $ 'ZHEEVX_2STAGE(N,I,' // UPLO // 825 $ ')', IINFO, N, JTYPE, IOLDSD 826 INFO = ABS( IINFO ) 827 IF( IINFO.LT.0 ) THEN 828 RETURN 829 ELSE 830 RESULT( NTEST ) = ULPINV 831 GO TO 160 832 END IF 833 END IF 834* 835* Do test 9. 836* 837 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 838 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 839 IF( N.GT.0 ) THEN 840 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 841 ELSE 842 TEMP3 = ZERO 843 END IF 844 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 845 $ MAX( UNFL, TEMP3*ULP ) 846* 847 160 CONTINUE 848 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 849* 850 NTEST = NTEST + 1 851* 852 CALL ZHEEVX( 'V', 'V', UPLO, N, A, LDU, VL, VU, IL, IU, 853 $ ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, RWORK, 854 $ IWORK, IWORK( 5*N+1 ), IINFO ) 855 IF( IINFO.NE.0 ) THEN 856 WRITE( NOUNIT, FMT = 9999 )'ZHEEVX(V,V,' // UPLO // 857 $ ')', IINFO, N, JTYPE, IOLDSD 858 INFO = ABS( IINFO ) 859 IF( IINFO.LT.0 ) THEN 860 RETURN 861 ELSE 862 RESULT( NTEST ) = ULPINV 863 GO TO 170 864 END IF 865 END IF 866* 867* Do tests 10 and 11. 868* 869 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 870* 871 CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 872 $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 873* 874 NTEST = NTEST + 2 875* 876 CALL ZHEEVX_2STAGE( 'N', 'V', UPLO, N, A, LDU, VL, VU, 877 $ IL, IU, ABSTOL, M3, WA3, Z, LDU, 878 $ WORK, LWORK, RWORK, IWORK, 879 $ IWORK( 5*N+1 ), IINFO ) 880 IF( IINFO.NE.0 ) THEN 881 WRITE( NOUNIT, FMT = 9999 ) 882 $ 'ZHEEVX_2STAGE(N,V,' // UPLO // 883 $ ')', IINFO, N, JTYPE, IOLDSD 884 INFO = ABS( IINFO ) 885 IF( IINFO.LT.0 ) THEN 886 RETURN 887 ELSE 888 RESULT( NTEST ) = ULPINV 889 GO TO 170 890 END IF 891 END IF 892* 893 IF( M3.EQ.0 .AND. N.GT.0 ) THEN 894 RESULT( NTEST ) = ULPINV 895 GO TO 170 896 END IF 897* 898* Do test 12. 899* 900 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 901 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 902 IF( N.GT.0 ) THEN 903 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 904 ELSE 905 TEMP3 = ZERO 906 END IF 907 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 908 $ MAX( UNFL, TEMP3*ULP ) 909* 910 170 CONTINUE 911* 912* Call ZHPEVD and CHPEVX. 913* 914 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 915* 916* Load array WORK with the upper or lower triangular 917* part of the matrix in packed form. 918* 919 IF( IUPLO.EQ.1 ) THEN 920 INDX = 1 921 DO 190 J = 1, N 922 DO 180 I = 1, J 923 WORK( INDX ) = A( I, J ) 924 INDX = INDX + 1 925 180 CONTINUE 926 190 CONTINUE 927 ELSE 928 INDX = 1 929 DO 210 J = 1, N 930 DO 200 I = J, N 931 WORK( INDX ) = A( I, J ) 932 INDX = INDX + 1 933 200 CONTINUE 934 210 CONTINUE 935 END IF 936* 937 NTEST = NTEST + 1 938 INDWRK = N*( N+1 ) / 2 + 1 939 CALL ZHPEVD( 'V', UPLO, N, WORK, D1, Z, LDU, 940 $ WORK( INDWRK ), LWEDC, RWORK, LRWEDC, IWORK, 941 $ LIWEDC, IINFO ) 942 IF( IINFO.NE.0 ) THEN 943 WRITE( NOUNIT, FMT = 9999 )'ZHPEVD(V,' // UPLO // 944 $ ')', IINFO, N, JTYPE, IOLDSD 945 INFO = ABS( IINFO ) 946 IF( IINFO.LT.0 ) THEN 947 RETURN 948 ELSE 949 RESULT( NTEST ) = ULPINV 950 RESULT( NTEST+1 ) = ULPINV 951 RESULT( NTEST+2 ) = ULPINV 952 GO TO 270 953 END IF 954 END IF 955* 956* Do tests 13 and 14. 957* 958 CALL ZHET21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V, 959 $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 960* 961 IF( IUPLO.EQ.1 ) THEN 962 INDX = 1 963 DO 230 J = 1, N 964 DO 220 I = 1, J 965 WORK( INDX ) = A( I, J ) 966 INDX = INDX + 1 967 220 CONTINUE 968 230 CONTINUE 969 ELSE 970 INDX = 1 971 DO 250 J = 1, N 972 DO 240 I = J, N 973 WORK( INDX ) = A( I, J ) 974 INDX = INDX + 1 975 240 CONTINUE 976 250 CONTINUE 977 END IF 978* 979 NTEST = NTEST + 2 980 INDWRK = N*( N+1 ) / 2 + 1 981 CALL ZHPEVD( 'N', UPLO, N, WORK, D3, Z, LDU, 982 $ WORK( INDWRK ), LWEDC, RWORK, LRWEDC, IWORK, 983 $ LIWEDC, IINFO ) 984 IF( IINFO.NE.0 ) THEN 985 WRITE( NOUNIT, FMT = 9999 )'ZHPEVD(N,' // UPLO // 986 $ ')', IINFO, N, JTYPE, IOLDSD 987 INFO = ABS( IINFO ) 988 IF( IINFO.LT.0 ) THEN 989 RETURN 990 ELSE 991 RESULT( NTEST ) = ULPINV 992 GO TO 270 993 END IF 994 END IF 995* 996* Do test 15. 997* 998 TEMP1 = ZERO 999 TEMP2 = ZERO 1000 DO 260 J = 1, N 1001 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 1002 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 1003 260 CONTINUE 1004 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 1005 $ ULP*MAX( TEMP1, TEMP2 ) ) 1006* 1007* Load array WORK with the upper or lower triangular part 1008* of the matrix in packed form. 1009* 1010 270 CONTINUE 1011 IF( IUPLO.EQ.1 ) THEN 1012 INDX = 1 1013 DO 290 J = 1, N 1014 DO 280 I = 1, J 1015 WORK( INDX ) = A( I, J ) 1016 INDX = INDX + 1 1017 280 CONTINUE 1018 290 CONTINUE 1019 ELSE 1020 INDX = 1 1021 DO 310 J = 1, N 1022 DO 300 I = J, N 1023 WORK( INDX ) = A( I, J ) 1024 INDX = INDX + 1 1025 300 CONTINUE 1026 310 CONTINUE 1027 END IF 1028* 1029 NTEST = NTEST + 1 1030* 1031 IF( N.GT.0 ) THEN 1032 TEMP3 = MAX( ABS( D1( 1 ) ), ABS( D1( N ) ) ) 1033 IF( IL.NE.1 ) THEN 1034 VL = D1( IL ) - MAX( HALF*( D1( IL )-D1( IL-1 ) ), 1035 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 1036 ELSE IF( N.GT.0 ) THEN 1037 VL = D1( 1 ) - MAX( HALF*( D1( N )-D1( 1 ) ), 1038 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 1039 END IF 1040 IF( IU.NE.N ) THEN 1041 VU = D1( IU ) + MAX( HALF*( D1( IU+1 )-D1( IU ) ), 1042 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 1043 ELSE IF( N.GT.0 ) THEN 1044 VU = D1( N ) + MAX( HALF*( D1( N )-D1( 1 ) ), 1045 $ TEN*ULP*TEMP3, TEN*RTUNFL ) 1046 END IF 1047 ELSE 1048 TEMP3 = ZERO 1049 VL = ZERO 1050 VU = ONE 1051 END IF 1052* 1053 CALL ZHPEVX( 'V', 'A', UPLO, N, WORK, VL, VU, IL, IU, 1054 $ ABSTOL, M, WA1, Z, LDU, V, RWORK, IWORK, 1055 $ IWORK( 5*N+1 ), IINFO ) 1056 IF( IINFO.NE.0 ) THEN 1057 WRITE( NOUNIT, FMT = 9999 )'ZHPEVX(V,A,' // UPLO // 1058 $ ')', IINFO, N, JTYPE, IOLDSD 1059 INFO = ABS( IINFO ) 1060 IF( IINFO.LT.0 ) THEN 1061 RETURN 1062 ELSE 1063 RESULT( NTEST ) = ULPINV 1064 RESULT( NTEST+1 ) = ULPINV 1065 RESULT( NTEST+2 ) = ULPINV 1066 GO TO 370 1067 END IF 1068 END IF 1069* 1070* Do tests 16 and 17. 1071* 1072 CALL ZHET21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V, 1073 $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 1074* 1075 NTEST = NTEST + 2 1076* 1077 IF( IUPLO.EQ.1 ) THEN 1078 INDX = 1 1079 DO 330 J = 1, N 1080 DO 320 I = 1, J 1081 WORK( INDX ) = A( I, J ) 1082 INDX = INDX + 1 1083 320 CONTINUE 1084 330 CONTINUE 1085 ELSE 1086 INDX = 1 1087 DO 350 J = 1, N 1088 DO 340 I = J, N 1089 WORK( INDX ) = A( I, J ) 1090 INDX = INDX + 1 1091 340 CONTINUE 1092 350 CONTINUE 1093 END IF 1094* 1095 CALL ZHPEVX( 'N', 'A', UPLO, N, WORK, VL, VU, IL, IU, 1096 $ ABSTOL, M2, WA2, Z, LDU, V, RWORK, IWORK, 1097 $ IWORK( 5*N+1 ), IINFO ) 1098 IF( IINFO.NE.0 ) THEN 1099 WRITE( NOUNIT, FMT = 9999 )'ZHPEVX(N,A,' // UPLO // 1100 $ ')', IINFO, N, JTYPE, IOLDSD 1101 INFO = ABS( IINFO ) 1102 IF( IINFO.LT.0 ) THEN 1103 RETURN 1104 ELSE 1105 RESULT( NTEST ) = ULPINV 1106 GO TO 370 1107 END IF 1108 END IF 1109* 1110* Do test 18. 1111* 1112 TEMP1 = ZERO 1113 TEMP2 = ZERO 1114 DO 360 J = 1, N 1115 TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) ) 1116 TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) ) 1117 360 CONTINUE 1118 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 1119 $ ULP*MAX( TEMP1, TEMP2 ) ) 1120* 1121 370 CONTINUE 1122 NTEST = NTEST + 1 1123 IF( IUPLO.EQ.1 ) THEN 1124 INDX = 1 1125 DO 390 J = 1, N 1126 DO 380 I = 1, J 1127 WORK( INDX ) = A( I, J ) 1128 INDX = INDX + 1 1129 380 CONTINUE 1130 390 CONTINUE 1131 ELSE 1132 INDX = 1 1133 DO 410 J = 1, N 1134 DO 400 I = J, N 1135 WORK( INDX ) = A( I, J ) 1136 INDX = INDX + 1 1137 400 CONTINUE 1138 410 CONTINUE 1139 END IF 1140* 1141 CALL ZHPEVX( 'V', 'I', UPLO, N, WORK, VL, VU, IL, IU, 1142 $ ABSTOL, M2, WA2, Z, LDU, V, RWORK, IWORK, 1143 $ IWORK( 5*N+1 ), IINFO ) 1144 IF( IINFO.NE.0 ) THEN 1145 WRITE( NOUNIT, FMT = 9999 )'ZHPEVX(V,I,' // UPLO // 1146 $ ')', IINFO, N, JTYPE, IOLDSD 1147 INFO = ABS( IINFO ) 1148 IF( IINFO.LT.0 ) THEN 1149 RETURN 1150 ELSE 1151 RESULT( NTEST ) = ULPINV 1152 RESULT( NTEST+1 ) = ULPINV 1153 RESULT( NTEST+2 ) = ULPINV 1154 GO TO 460 1155 END IF 1156 END IF 1157* 1158* Do tests 19 and 20. 1159* 1160 CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 1161 $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 1162* 1163 NTEST = NTEST + 2 1164* 1165 IF( IUPLO.EQ.1 ) THEN 1166 INDX = 1 1167 DO 430 J = 1, N 1168 DO 420 I = 1, J 1169 WORK( INDX ) = A( I, J ) 1170 INDX = INDX + 1 1171 420 CONTINUE 1172 430 CONTINUE 1173 ELSE 1174 INDX = 1 1175 DO 450 J = 1, N 1176 DO 440 I = J, N 1177 WORK( INDX ) = A( I, J ) 1178 INDX = INDX + 1 1179 440 CONTINUE 1180 450 CONTINUE 1181 END IF 1182* 1183 CALL ZHPEVX( 'N', 'I', UPLO, N, WORK, VL, VU, IL, IU, 1184 $ ABSTOL, M3, WA3, Z, LDU, V, RWORK, IWORK, 1185 $ IWORK( 5*N+1 ), IINFO ) 1186 IF( IINFO.NE.0 ) THEN 1187 WRITE( NOUNIT, FMT = 9999 )'ZHPEVX(N,I,' // UPLO // 1188 $ ')', IINFO, N, JTYPE, IOLDSD 1189 INFO = ABS( IINFO ) 1190 IF( IINFO.LT.0 ) THEN 1191 RETURN 1192 ELSE 1193 RESULT( NTEST ) = ULPINV 1194 GO TO 460 1195 END IF 1196 END IF 1197* 1198* Do test 21. 1199* 1200 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 1201 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 1202 IF( N.GT.0 ) THEN 1203 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 1204 ELSE 1205 TEMP3 = ZERO 1206 END IF 1207 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 1208 $ MAX( UNFL, TEMP3*ULP ) 1209* 1210 460 CONTINUE 1211 NTEST = NTEST + 1 1212 IF( IUPLO.EQ.1 ) THEN 1213 INDX = 1 1214 DO 480 J = 1, N 1215 DO 470 I = 1, J 1216 WORK( INDX ) = A( I, J ) 1217 INDX = INDX + 1 1218 470 CONTINUE 1219 480 CONTINUE 1220 ELSE 1221 INDX = 1 1222 DO 500 J = 1, N 1223 DO 490 I = J, N 1224 WORK( INDX ) = A( I, J ) 1225 INDX = INDX + 1 1226 490 CONTINUE 1227 500 CONTINUE 1228 END IF 1229* 1230 CALL ZHPEVX( 'V', 'V', UPLO, N, WORK, VL, VU, IL, IU, 1231 $ ABSTOL, M2, WA2, Z, LDU, V, RWORK, IWORK, 1232 $ IWORK( 5*N+1 ), IINFO ) 1233 IF( IINFO.NE.0 ) THEN 1234 WRITE( NOUNIT, FMT = 9999 )'ZHPEVX(V,V,' // UPLO // 1235 $ ')', IINFO, N, JTYPE, IOLDSD 1236 INFO = ABS( IINFO ) 1237 IF( IINFO.LT.0 ) THEN 1238 RETURN 1239 ELSE 1240 RESULT( NTEST ) = ULPINV 1241 RESULT( NTEST+1 ) = ULPINV 1242 RESULT( NTEST+2 ) = ULPINV 1243 GO TO 550 1244 END IF 1245 END IF 1246* 1247* Do tests 22 and 23. 1248* 1249 CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 1250 $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 1251* 1252 NTEST = NTEST + 2 1253* 1254 IF( IUPLO.EQ.1 ) THEN 1255 INDX = 1 1256 DO 520 J = 1, N 1257 DO 510 I = 1, J 1258 WORK( INDX ) = A( I, J ) 1259 INDX = INDX + 1 1260 510 CONTINUE 1261 520 CONTINUE 1262 ELSE 1263 INDX = 1 1264 DO 540 J = 1, N 1265 DO 530 I = J, N 1266 WORK( INDX ) = A( I, J ) 1267 INDX = INDX + 1 1268 530 CONTINUE 1269 540 CONTINUE 1270 END IF 1271* 1272 CALL ZHPEVX( 'N', 'V', UPLO, N, WORK, VL, VU, IL, IU, 1273 $ ABSTOL, M3, WA3, Z, LDU, V, RWORK, IWORK, 1274 $ IWORK( 5*N+1 ), IINFO ) 1275 IF( IINFO.NE.0 ) THEN 1276 WRITE( NOUNIT, FMT = 9999 )'ZHPEVX(N,V,' // UPLO // 1277 $ ')', IINFO, N, JTYPE, IOLDSD 1278 INFO = ABS( IINFO ) 1279 IF( IINFO.LT.0 ) THEN 1280 RETURN 1281 ELSE 1282 RESULT( NTEST ) = ULPINV 1283 GO TO 550 1284 END IF 1285 END IF 1286* 1287 IF( M3.EQ.0 .AND. N.GT.0 ) THEN 1288 RESULT( NTEST ) = ULPINV 1289 GO TO 550 1290 END IF 1291* 1292* Do test 24. 1293* 1294 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 1295 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 1296 IF( N.GT.0 ) THEN 1297 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 1298 ELSE 1299 TEMP3 = ZERO 1300 END IF 1301 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 1302 $ MAX( UNFL, TEMP3*ULP ) 1303* 1304 550 CONTINUE 1305* 1306* Call ZHBEVD and CHBEVX. 1307* 1308 IF( JTYPE.LE.7 ) THEN 1309 KD = 0 1310 ELSE IF( JTYPE.GE.8 .AND. JTYPE.LE.15 ) THEN 1311 KD = MAX( N-1, 0 ) 1312 ELSE 1313 KD = IHBW 1314 END IF 1315* 1316* Load array V with the upper or lower triangular part 1317* of the matrix in band form. 1318* 1319 IF( IUPLO.EQ.1 ) THEN 1320 DO 570 J = 1, N 1321 DO 560 I = MAX( 1, J-KD ), J 1322 V( KD+1+I-J, J ) = A( I, J ) 1323 560 CONTINUE 1324 570 CONTINUE 1325 ELSE 1326 DO 590 J = 1, N 1327 DO 580 I = J, MIN( N, J+KD ) 1328 V( 1+I-J, J ) = A( I, J ) 1329 580 CONTINUE 1330 590 CONTINUE 1331 END IF 1332* 1333 NTEST = NTEST + 1 1334 CALL ZHBEVD( 'V', UPLO, N, KD, V, LDU, D1, Z, LDU, WORK, 1335 $ LWEDC, RWORK, LRWEDC, IWORK, LIWEDC, IINFO ) 1336 IF( IINFO.NE.0 ) THEN 1337 WRITE( NOUNIT, FMT = 9998 )'ZHBEVD(V,' // UPLO // 1338 $ ')', IINFO, N, KD, JTYPE, IOLDSD 1339 INFO = ABS( IINFO ) 1340 IF( IINFO.LT.0 ) THEN 1341 RETURN 1342 ELSE 1343 RESULT( NTEST ) = ULPINV 1344 RESULT( NTEST+1 ) = ULPINV 1345 RESULT( NTEST+2 ) = ULPINV 1346 GO TO 650 1347 END IF 1348 END IF 1349* 1350* Do tests 25 and 26. 1351* 1352 CALL ZHET21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V, 1353 $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 1354* 1355 IF( IUPLO.EQ.1 ) THEN 1356 DO 610 J = 1, N 1357 DO 600 I = MAX( 1, J-KD ), J 1358 V( KD+1+I-J, J ) = A( I, J ) 1359 600 CONTINUE 1360 610 CONTINUE 1361 ELSE 1362 DO 630 J = 1, N 1363 DO 620 I = J, MIN( N, J+KD ) 1364 V( 1+I-J, J ) = A( I, J ) 1365 620 CONTINUE 1366 630 CONTINUE 1367 END IF 1368* 1369 NTEST = NTEST + 2 1370 CALL ZHBEVD_2STAGE( 'N', UPLO, N, KD, V, LDU, D3, 1371 $ Z, LDU, WORK, LWORK, RWORK, 1372 $ LRWEDC, IWORK, LIWEDC, IINFO ) 1373 IF( IINFO.NE.0 ) THEN 1374 WRITE( NOUNIT, FMT = 9998 ) 1375 $ 'ZHBEVD_2STAGE(N,' // UPLO // 1376 $ ')', IINFO, N, KD, JTYPE, IOLDSD 1377 INFO = ABS( IINFO ) 1378 IF( IINFO.LT.0 ) THEN 1379 RETURN 1380 ELSE 1381 RESULT( NTEST ) = ULPINV 1382 GO TO 650 1383 END IF 1384 END IF 1385* 1386* Do test 27. 1387* 1388 TEMP1 = ZERO 1389 TEMP2 = ZERO 1390 DO 640 J = 1, N 1391 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 1392 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 1393 640 CONTINUE 1394 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 1395 $ ULP*MAX( TEMP1, TEMP2 ) ) 1396* 1397* Load array V with the upper or lower triangular part 1398* of the matrix in band form. 1399* 1400 650 CONTINUE 1401 IF( IUPLO.EQ.1 ) THEN 1402 DO 670 J = 1, N 1403 DO 660 I = MAX( 1, J-KD ), J 1404 V( KD+1+I-J, J ) = A( I, J ) 1405 660 CONTINUE 1406 670 CONTINUE 1407 ELSE 1408 DO 690 J = 1, N 1409 DO 680 I = J, MIN( N, J+KD ) 1410 V( 1+I-J, J ) = A( I, J ) 1411 680 CONTINUE 1412 690 CONTINUE 1413 END IF 1414* 1415 NTEST = NTEST + 1 1416 CALL ZHBEVX( 'V', 'A', UPLO, N, KD, V, LDU, U, LDU, VL, 1417 $ VU, IL, IU, ABSTOL, M, WA1, Z, LDU, WORK, 1418 $ RWORK, IWORK, IWORK( 5*N+1 ), IINFO ) 1419 IF( IINFO.NE.0 ) THEN 1420 WRITE( NOUNIT, FMT = 9999 )'ZHBEVX(V,A,' // UPLO // 1421 $ ')', IINFO, N, KD, JTYPE, IOLDSD 1422 INFO = ABS( IINFO ) 1423 IF( IINFO.LT.0 ) THEN 1424 RETURN 1425 ELSE 1426 RESULT( NTEST ) = ULPINV 1427 RESULT( NTEST+1 ) = ULPINV 1428 RESULT( NTEST+2 ) = ULPINV 1429 GO TO 750 1430 END IF 1431 END IF 1432* 1433* Do tests 28 and 29. 1434* 1435 CALL ZHET21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V, 1436 $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 1437* 1438 NTEST = NTEST + 2 1439* 1440 IF( IUPLO.EQ.1 ) THEN 1441 DO 710 J = 1, N 1442 DO 700 I = MAX( 1, J-KD ), J 1443 V( KD+1+I-J, J ) = A( I, J ) 1444 700 CONTINUE 1445 710 CONTINUE 1446 ELSE 1447 DO 730 J = 1, N 1448 DO 720 I = J, MIN( N, J+KD ) 1449 V( 1+I-J, J ) = A( I, J ) 1450 720 CONTINUE 1451 730 CONTINUE 1452 END IF 1453* 1454 CALL ZHBEVX_2STAGE( 'N', 'A', UPLO, N, KD, V, LDU, 1455 $ U, LDU, VL, VU, IL, IU, ABSTOL, 1456 $ M2, WA2, Z, LDU, WORK, LWORK, 1457 $ RWORK, IWORK, IWORK( 5*N+1 ), IINFO ) 1458 IF( IINFO.NE.0 ) THEN 1459 WRITE( NOUNIT, FMT = 9998 ) 1460 $ 'ZHBEVX_2STAGE(N,A,' // UPLO // 1461 $ ')', IINFO, N, KD, JTYPE, IOLDSD 1462 INFO = ABS( IINFO ) 1463 IF( IINFO.LT.0 ) THEN 1464 RETURN 1465 ELSE 1466 RESULT( NTEST ) = ULPINV 1467 GO TO 750 1468 END IF 1469 END IF 1470* 1471* Do test 30. 1472* 1473 TEMP1 = ZERO 1474 TEMP2 = ZERO 1475 DO 740 J = 1, N 1476 TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) ) 1477 TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) ) 1478 740 CONTINUE 1479 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 1480 $ ULP*MAX( TEMP1, TEMP2 ) ) 1481* 1482* Load array V with the upper or lower triangular part 1483* of the matrix in band form. 1484* 1485 750 CONTINUE 1486 NTEST = NTEST + 1 1487 IF( IUPLO.EQ.1 ) THEN 1488 DO 770 J = 1, N 1489 DO 760 I = MAX( 1, J-KD ), J 1490 V( KD+1+I-J, J ) = A( I, J ) 1491 760 CONTINUE 1492 770 CONTINUE 1493 ELSE 1494 DO 790 J = 1, N 1495 DO 780 I = J, MIN( N, J+KD ) 1496 V( 1+I-J, J ) = A( I, J ) 1497 780 CONTINUE 1498 790 CONTINUE 1499 END IF 1500* 1501 CALL ZHBEVX( 'V', 'I', UPLO, N, KD, V, LDU, U, LDU, VL, 1502 $ VU, IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK, 1503 $ RWORK, IWORK, IWORK( 5*N+1 ), IINFO ) 1504 IF( IINFO.NE.0 ) THEN 1505 WRITE( NOUNIT, FMT = 9998 )'ZHBEVX(V,I,' // UPLO // 1506 $ ')', IINFO, N, KD, JTYPE, IOLDSD 1507 INFO = ABS( IINFO ) 1508 IF( IINFO.LT.0 ) THEN 1509 RETURN 1510 ELSE 1511 RESULT( NTEST ) = ULPINV 1512 RESULT( NTEST+1 ) = ULPINV 1513 RESULT( NTEST+2 ) = ULPINV 1514 GO TO 840 1515 END IF 1516 END IF 1517* 1518* Do tests 31 and 32. 1519* 1520 CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 1521 $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 1522* 1523 NTEST = NTEST + 2 1524* 1525 IF( IUPLO.EQ.1 ) THEN 1526 DO 810 J = 1, N 1527 DO 800 I = MAX( 1, J-KD ), J 1528 V( KD+1+I-J, J ) = A( I, J ) 1529 800 CONTINUE 1530 810 CONTINUE 1531 ELSE 1532 DO 830 J = 1, N 1533 DO 820 I = J, MIN( N, J+KD ) 1534 V( 1+I-J, J ) = A( I, J ) 1535 820 CONTINUE 1536 830 CONTINUE 1537 END IF 1538 CALL ZHBEVX_2STAGE( 'N', 'I', UPLO, N, KD, V, LDU, 1539 $ U, LDU, VL, VU, IL, IU, ABSTOL, 1540 $ M3, WA3, Z, LDU, WORK, LWORK, 1541 $ RWORK, IWORK, IWORK( 5*N+1 ), IINFO ) 1542 IF( IINFO.NE.0 ) THEN 1543 WRITE( NOUNIT, FMT = 9998 ) 1544 $ 'ZHBEVX_2STAGE(N,I,' // UPLO // 1545 $ ')', IINFO, N, KD, JTYPE, IOLDSD 1546 INFO = ABS( IINFO ) 1547 IF( IINFO.LT.0 ) THEN 1548 RETURN 1549 ELSE 1550 RESULT( NTEST ) = ULPINV 1551 GO TO 840 1552 END IF 1553 END IF 1554* 1555* Do test 33. 1556* 1557 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 1558 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 1559 IF( N.GT.0 ) THEN 1560 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 1561 ELSE 1562 TEMP3 = ZERO 1563 END IF 1564 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 1565 $ MAX( UNFL, TEMP3*ULP ) 1566* 1567* Load array V with the upper or lower triangular part 1568* of the matrix in band form. 1569* 1570 840 CONTINUE 1571 NTEST = NTEST + 1 1572 IF( IUPLO.EQ.1 ) THEN 1573 DO 860 J = 1, N 1574 DO 850 I = MAX( 1, J-KD ), J 1575 V( KD+1+I-J, J ) = A( I, J ) 1576 850 CONTINUE 1577 860 CONTINUE 1578 ELSE 1579 DO 880 J = 1, N 1580 DO 870 I = J, MIN( N, J+KD ) 1581 V( 1+I-J, J ) = A( I, J ) 1582 870 CONTINUE 1583 880 CONTINUE 1584 END IF 1585 CALL ZHBEVX( 'V', 'V', UPLO, N, KD, V, LDU, U, LDU, VL, 1586 $ VU, IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK, 1587 $ RWORK, IWORK, IWORK( 5*N+1 ), IINFO ) 1588 IF( IINFO.NE.0 ) THEN 1589 WRITE( NOUNIT, FMT = 9998 )'ZHBEVX(V,V,' // UPLO // 1590 $ ')', IINFO, N, KD, JTYPE, IOLDSD 1591 INFO = ABS( IINFO ) 1592 IF( IINFO.LT.0 ) THEN 1593 RETURN 1594 ELSE 1595 RESULT( NTEST ) = ULPINV 1596 RESULT( NTEST+1 ) = ULPINV 1597 RESULT( NTEST+2 ) = ULPINV 1598 GO TO 930 1599 END IF 1600 END IF 1601* 1602* Do tests 34 and 35. 1603* 1604 CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 1605 $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 1606* 1607 NTEST = NTEST + 2 1608* 1609 IF( IUPLO.EQ.1 ) THEN 1610 DO 900 J = 1, N 1611 DO 890 I = MAX( 1, J-KD ), J 1612 V( KD+1+I-J, J ) = A( I, J ) 1613 890 CONTINUE 1614 900 CONTINUE 1615 ELSE 1616 DO 920 J = 1, N 1617 DO 910 I = J, MIN( N, J+KD ) 1618 V( 1+I-J, J ) = A( I, J ) 1619 910 CONTINUE 1620 920 CONTINUE 1621 END IF 1622 CALL ZHBEVX_2STAGE( 'N', 'V', UPLO, N, KD, V, LDU, 1623 $ U, LDU, VL, VU, IL, IU, ABSTOL, 1624 $ M3, WA3, Z, LDU, WORK, LWORK, 1625 $ RWORK, IWORK, IWORK( 5*N+1 ), IINFO ) 1626 IF( IINFO.NE.0 ) THEN 1627 WRITE( NOUNIT, FMT = 9998 ) 1628 $ 'ZHBEVX_2STAGE(N,V,' // UPLO // 1629 $ ')', IINFO, N, KD, JTYPE, IOLDSD 1630 INFO = ABS( IINFO ) 1631 IF( IINFO.LT.0 ) THEN 1632 RETURN 1633 ELSE 1634 RESULT( NTEST ) = ULPINV 1635 GO TO 930 1636 END IF 1637 END IF 1638* 1639 IF( M3.EQ.0 .AND. N.GT.0 ) THEN 1640 RESULT( NTEST ) = ULPINV 1641 GO TO 930 1642 END IF 1643* 1644* Do test 36. 1645* 1646 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 1647 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 1648 IF( N.GT.0 ) THEN 1649 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 1650 ELSE 1651 TEMP3 = ZERO 1652 END IF 1653 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 1654 $ MAX( UNFL, TEMP3*ULP ) 1655* 1656 930 CONTINUE 1657* 1658* Call ZHEEV 1659* 1660 CALL ZLACPY( ' ', N, N, A, LDA, V, LDU ) 1661* 1662 NTEST = NTEST + 1 1663 CALL ZHEEV( 'V', UPLO, N, A, LDU, D1, WORK, LWORK, RWORK, 1664 $ IINFO ) 1665 IF( IINFO.NE.0 ) THEN 1666 WRITE( NOUNIT, FMT = 9999 )'ZHEEV(V,' // UPLO // ')', 1667 $ IINFO, N, JTYPE, IOLDSD 1668 INFO = ABS( IINFO ) 1669 IF( IINFO.LT.0 ) THEN 1670 RETURN 1671 ELSE 1672 RESULT( NTEST ) = ULPINV 1673 RESULT( NTEST+1 ) = ULPINV 1674 RESULT( NTEST+2 ) = ULPINV 1675 GO TO 950 1676 END IF 1677 END IF 1678* 1679* Do tests 37 and 38 1680* 1681 CALL ZHET21( 1, UPLO, N, 0, V, LDU, D1, D2, A, LDU, Z, 1682 $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 1683* 1684 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 1685* 1686 NTEST = NTEST + 2 1687 CALL ZHEEV_2STAGE( 'N', UPLO, N, A, LDU, D3, 1688 $ WORK, LWORK, RWORK, IINFO ) 1689 IF( IINFO.NE.0 ) THEN 1690 WRITE( NOUNIT, FMT = 9999 ) 1691 $ 'ZHEEV_2STAGE(N,' // UPLO // ')', 1692 $ IINFO, N, JTYPE, IOLDSD 1693 INFO = ABS( IINFO ) 1694 IF( IINFO.LT.0 ) THEN 1695 RETURN 1696 ELSE 1697 RESULT( NTEST ) = ULPINV 1698 GO TO 950 1699 END IF 1700 END IF 1701* 1702* Do test 39 1703* 1704 TEMP1 = ZERO 1705 TEMP2 = ZERO 1706 DO 940 J = 1, N 1707 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 1708 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 1709 940 CONTINUE 1710 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 1711 $ ULP*MAX( TEMP1, TEMP2 ) ) 1712* 1713 950 CONTINUE 1714* 1715 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 1716* 1717* Call ZHPEV 1718* 1719* Load array WORK with the upper or lower triangular 1720* part of the matrix in packed form. 1721* 1722 IF( IUPLO.EQ.1 ) THEN 1723 INDX = 1 1724 DO 970 J = 1, N 1725 DO 960 I = 1, J 1726 WORK( INDX ) = A( I, J ) 1727 INDX = INDX + 1 1728 960 CONTINUE 1729 970 CONTINUE 1730 ELSE 1731 INDX = 1 1732 DO 990 J = 1, N 1733 DO 980 I = J, N 1734 WORK( INDX ) = A( I, J ) 1735 INDX = INDX + 1 1736 980 CONTINUE 1737 990 CONTINUE 1738 END IF 1739* 1740 NTEST = NTEST + 1 1741 INDWRK = N*( N+1 ) / 2 + 1 1742 CALL ZHPEV( 'V', UPLO, N, WORK, D1, Z, LDU, 1743 $ WORK( INDWRK ), RWORK, IINFO ) 1744 IF( IINFO.NE.0 ) THEN 1745 WRITE( NOUNIT, FMT = 9999 )'ZHPEV(V,' // UPLO // ')', 1746 $ IINFO, N, JTYPE, IOLDSD 1747 INFO = ABS( IINFO ) 1748 IF( IINFO.LT.0 ) THEN 1749 RETURN 1750 ELSE 1751 RESULT( NTEST ) = ULPINV 1752 RESULT( NTEST+1 ) = ULPINV 1753 RESULT( NTEST+2 ) = ULPINV 1754 GO TO 1050 1755 END IF 1756 END IF 1757* 1758* Do tests 40 and 41. 1759* 1760 CALL ZHET21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V, 1761 $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 1762* 1763 IF( IUPLO.EQ.1 ) THEN 1764 INDX = 1 1765 DO 1010 J = 1, N 1766 DO 1000 I = 1, J 1767 WORK( INDX ) = A( I, J ) 1768 INDX = INDX + 1 1769 1000 CONTINUE 1770 1010 CONTINUE 1771 ELSE 1772 INDX = 1 1773 DO 1030 J = 1, N 1774 DO 1020 I = J, N 1775 WORK( INDX ) = A( I, J ) 1776 INDX = INDX + 1 1777 1020 CONTINUE 1778 1030 CONTINUE 1779 END IF 1780* 1781 NTEST = NTEST + 2 1782 INDWRK = N*( N+1 ) / 2 + 1 1783 CALL ZHPEV( 'N', UPLO, N, WORK, D3, Z, LDU, 1784 $ WORK( INDWRK ), RWORK, IINFO ) 1785 IF( IINFO.NE.0 ) THEN 1786 WRITE( NOUNIT, FMT = 9999 )'ZHPEV(N,' // UPLO // ')', 1787 $ IINFO, N, JTYPE, IOLDSD 1788 INFO = ABS( IINFO ) 1789 IF( IINFO.LT.0 ) THEN 1790 RETURN 1791 ELSE 1792 RESULT( NTEST ) = ULPINV 1793 GO TO 1050 1794 END IF 1795 END IF 1796* 1797* Do test 42 1798* 1799 TEMP1 = ZERO 1800 TEMP2 = ZERO 1801 DO 1040 J = 1, N 1802 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 1803 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 1804 1040 CONTINUE 1805 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 1806 $ ULP*MAX( TEMP1, TEMP2 ) ) 1807* 1808 1050 CONTINUE 1809* 1810* Call ZHBEV 1811* 1812 IF( JTYPE.LE.7 ) THEN 1813 KD = 0 1814 ELSE IF( JTYPE.GE.8 .AND. JTYPE.LE.15 ) THEN 1815 KD = MAX( N-1, 0 ) 1816 ELSE 1817 KD = IHBW 1818 END IF 1819* 1820* Load array V with the upper or lower triangular part 1821* of the matrix in band form. 1822* 1823 IF( IUPLO.EQ.1 ) THEN 1824 DO 1070 J = 1, N 1825 DO 1060 I = MAX( 1, J-KD ), J 1826 V( KD+1+I-J, J ) = A( I, J ) 1827 1060 CONTINUE 1828 1070 CONTINUE 1829 ELSE 1830 DO 1090 J = 1, N 1831 DO 1080 I = J, MIN( N, J+KD ) 1832 V( 1+I-J, J ) = A( I, J ) 1833 1080 CONTINUE 1834 1090 CONTINUE 1835 END IF 1836* 1837 NTEST = NTEST + 1 1838 CALL ZHBEV( 'V', UPLO, N, KD, V, LDU, D1, Z, LDU, WORK, 1839 $ RWORK, IINFO ) 1840 IF( IINFO.NE.0 ) THEN 1841 WRITE( NOUNIT, FMT = 9998 )'ZHBEV(V,' // UPLO // ')', 1842 $ IINFO, N, KD, JTYPE, IOLDSD 1843 INFO = ABS( IINFO ) 1844 IF( IINFO.LT.0 ) THEN 1845 RETURN 1846 ELSE 1847 RESULT( NTEST ) = ULPINV 1848 RESULT( NTEST+1 ) = ULPINV 1849 RESULT( NTEST+2 ) = ULPINV 1850 GO TO 1140 1851 END IF 1852 END IF 1853* 1854* Do tests 43 and 44. 1855* 1856 CALL ZHET21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V, 1857 $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 1858* 1859 IF( IUPLO.EQ.1 ) THEN 1860 DO 1110 J = 1, N 1861 DO 1100 I = MAX( 1, J-KD ), J 1862 V( KD+1+I-J, J ) = A( I, J ) 1863 1100 CONTINUE 1864 1110 CONTINUE 1865 ELSE 1866 DO 1130 J = 1, N 1867 DO 1120 I = J, MIN( N, J+KD ) 1868 V( 1+I-J, J ) = A( I, J ) 1869 1120 CONTINUE 1870 1130 CONTINUE 1871 END IF 1872* 1873 NTEST = NTEST + 2 1874 CALL ZHBEV_2STAGE( 'N', UPLO, N, KD, V, LDU, D3, Z, LDU, 1875 $ WORK, LWORK, RWORK, IINFO ) 1876 IF( IINFO.NE.0 ) THEN 1877 WRITE( NOUNIT, FMT = 9998 ) 1878 $ 'ZHBEV_2STAGE(N,' // UPLO // ')', 1879 $ IINFO, N, KD, JTYPE, IOLDSD 1880 INFO = ABS( IINFO ) 1881 IF( IINFO.LT.0 ) THEN 1882 RETURN 1883 ELSE 1884 RESULT( NTEST ) = ULPINV 1885 GO TO 1140 1886 END IF 1887 END IF 1888* 1889 1140 CONTINUE 1890* 1891* Do test 45. 1892* 1893 TEMP1 = ZERO 1894 TEMP2 = ZERO 1895 DO 1150 J = 1, N 1896 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) ) 1897 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) ) 1898 1150 CONTINUE 1899 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 1900 $ ULP*MAX( TEMP1, TEMP2 ) ) 1901* 1902 CALL ZLACPY( ' ', N, N, A, LDA, V, LDU ) 1903 NTEST = NTEST + 1 1904 CALL ZHEEVR( 'V', 'A', UPLO, N, A, LDU, VL, VU, IL, IU, 1905 $ ABSTOL, M, WA1, Z, LDU, IWORK, WORK, LWORK, 1906 $ RWORK, LRWORK, IWORK( 2*N+1 ), LIWORK-2*N, 1907 $ IINFO ) 1908 IF( IINFO.NE.0 ) THEN 1909 WRITE( NOUNIT, FMT = 9999 )'ZHEEVR(V,A,' // UPLO // 1910 $ ')', IINFO, N, JTYPE, IOLDSD 1911 INFO = ABS( IINFO ) 1912 IF( IINFO.LT.0 ) THEN 1913 RETURN 1914 ELSE 1915 RESULT( NTEST ) = ULPINV 1916 RESULT( NTEST+1 ) = ULPINV 1917 RESULT( NTEST+2 ) = ULPINV 1918 GO TO 1170 1919 END IF 1920 END IF 1921* 1922* Do tests 45 and 46 (or ... ) 1923* 1924 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 1925* 1926 CALL ZHET21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V, 1927 $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 1928* 1929 NTEST = NTEST + 2 1930 CALL ZHEEVR_2STAGE( 'N', 'A', UPLO, N, A, LDU, VL, VU, 1931 $ IL, IU, ABSTOL, M2, WA2, Z, LDU, 1932 $ IWORK, WORK, LWORK, RWORK, LRWORK, 1933 $ IWORK( 2*N+1 ), LIWORK-2*N, IINFO ) 1934 IF( IINFO.NE.0 ) THEN 1935 WRITE( NOUNIT, FMT = 9999 ) 1936 $ 'ZHEEVR_2STAGE(N,A,' // UPLO // 1937 $ ')', IINFO, N, JTYPE, IOLDSD 1938 INFO = ABS( IINFO ) 1939 IF( IINFO.LT.0 ) THEN 1940 RETURN 1941 ELSE 1942 RESULT( NTEST ) = ULPINV 1943 GO TO 1170 1944 END IF 1945 END IF 1946* 1947* Do test 47 (or ... ) 1948* 1949 TEMP1 = ZERO 1950 TEMP2 = ZERO 1951 DO 1160 J = 1, N 1952 TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) ) 1953 TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) ) 1954 1160 CONTINUE 1955 RESULT( NTEST ) = TEMP2 / MAX( UNFL, 1956 $ ULP*MAX( TEMP1, TEMP2 ) ) 1957* 1958 1170 CONTINUE 1959* 1960 NTEST = NTEST + 1 1961 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 1962 CALL ZHEEVR( 'V', 'I', UPLO, N, A, LDU, VL, VU, IL, IU, 1963 $ ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK, 1964 $ RWORK, LRWORK, IWORK( 2*N+1 ), LIWORK-2*N, 1965 $ IINFO ) 1966 IF( IINFO.NE.0 ) THEN 1967 WRITE( NOUNIT, FMT = 9999 )'ZHEEVR(V,I,' // UPLO // 1968 $ ')', IINFO, N, JTYPE, IOLDSD 1969 INFO = ABS( IINFO ) 1970 IF( IINFO.LT.0 ) THEN 1971 RETURN 1972 ELSE 1973 RESULT( NTEST ) = ULPINV 1974 RESULT( NTEST+1 ) = ULPINV 1975 RESULT( NTEST+2 ) = ULPINV 1976 GO TO 1180 1977 END IF 1978 END IF 1979* 1980* Do tests 48 and 49 (or +??) 1981* 1982 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 1983* 1984 CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 1985 $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 1986* 1987 NTEST = NTEST + 2 1988 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 1989 CALL ZHEEVR_2STAGE( 'N', 'I', UPLO, N, A, LDU, VL, VU, 1990 $ IL, IU, ABSTOL, M3, WA3, Z, LDU, 1991 $ IWORK, WORK, LWORK, RWORK, LRWORK, 1992 $ IWORK( 2*N+1 ), LIWORK-2*N, IINFO ) 1993 IF( IINFO.NE.0 ) THEN 1994 WRITE( NOUNIT, FMT = 9999 ) 1995 $ 'ZHEEVR_2STAGE(N,I,' // UPLO // 1996 $ ')', IINFO, N, JTYPE, IOLDSD 1997 INFO = ABS( IINFO ) 1998 IF( IINFO.LT.0 ) THEN 1999 RETURN 2000 ELSE 2001 RESULT( NTEST ) = ULPINV 2002 GO TO 1180 2003 END IF 2004 END IF 2005* 2006* Do test 50 (or +??) 2007* 2008 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 2009 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 2010 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 2011 $ MAX( UNFL, ULP*TEMP3 ) 2012 1180 CONTINUE 2013* 2014 NTEST = NTEST + 1 2015 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 2016 CALL ZHEEVR( 'V', 'V', UPLO, N, A, LDU, VL, VU, IL, IU, 2017 $ ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK, 2018 $ RWORK, LRWORK, IWORK( 2*N+1 ), LIWORK-2*N, 2019 $ IINFO ) 2020 IF( IINFO.NE.0 ) THEN 2021 WRITE( NOUNIT, FMT = 9999 )'ZHEEVR(V,V,' // UPLO // 2022 $ ')', IINFO, N, JTYPE, IOLDSD 2023 INFO = ABS( IINFO ) 2024 IF( IINFO.LT.0 ) THEN 2025 RETURN 2026 ELSE 2027 RESULT( NTEST ) = ULPINV 2028 RESULT( NTEST+1 ) = ULPINV 2029 RESULT( NTEST+2 ) = ULPINV 2030 GO TO 1190 2031 END IF 2032 END IF 2033* 2034* Do tests 51 and 52 (or +??) 2035* 2036 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 2037* 2038 CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU, 2039 $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) ) 2040* 2041 NTEST = NTEST + 2 2042 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 2043 CALL ZHEEVR_2STAGE( 'N', 'V', UPLO, N, A, LDU, VL, VU, 2044 $ IL, IU, ABSTOL, M3, WA3, Z, LDU, 2045 $ IWORK, WORK, LWORK, RWORK, LRWORK, 2046 $ IWORK( 2*N+1 ), LIWORK-2*N, IINFO ) 2047 IF( IINFO.NE.0 ) THEN 2048 WRITE( NOUNIT, FMT = 9999 ) 2049 $ 'ZHEEVR_2STAGE(N,V,' // UPLO // 2050 $ ')', IINFO, N, JTYPE, IOLDSD 2051 INFO = ABS( IINFO ) 2052 IF( IINFO.LT.0 ) THEN 2053 RETURN 2054 ELSE 2055 RESULT( NTEST ) = ULPINV 2056 GO TO 1190 2057 END IF 2058 END IF 2059* 2060 IF( M3.EQ.0 .AND. N.GT.0 ) THEN 2061 RESULT( NTEST ) = ULPINV 2062 GO TO 1190 2063 END IF 2064* 2065* Do test 52 (or +??) 2066* 2067 TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL ) 2068 TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL ) 2069 IF( N.GT.0 ) THEN 2070 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) ) 2071 ELSE 2072 TEMP3 = ZERO 2073 END IF 2074 RESULT( NTEST ) = ( TEMP1+TEMP2 ) / 2075 $ MAX( UNFL, TEMP3*ULP ) 2076* 2077 CALL ZLACPY( ' ', N, N, V, LDU, A, LDA ) 2078* 2079* 2080* 2081* 2082* Load array V with the upper or lower triangular part 2083* of the matrix in band form. 2084* 2085 1190 CONTINUE 2086* 2087 1200 CONTINUE 2088* 2089* End of Loop -- Check for RESULT(j) > THRESH 2090* 2091 NTESTT = NTESTT + NTEST 2092 CALL DLAFTS( 'ZST', N, N, JTYPE, NTEST, RESULT, IOLDSD, 2093 $ THRESH, NOUNIT, NERRS ) 2094* 2095 1210 CONTINUE 2096 1220 CONTINUE 2097* 2098* Summary 2099* 2100 CALL ALASVM( 'ZST', NOUNIT, NERRS, NTESTT, 0 ) 2101* 2102 9999 FORMAT( ' ZDRVST2STG: ', A, ' returned INFO=', I6, / 9X, 'N=', I6, 2103 $ ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' ) 2104 9998 FORMAT( ' ZDRVST2STG: ', A, ' returned INFO=', I6, / 9X, 'N=', I6, 2105 $ ', KD=', I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, 2106 $ ')' ) 2107* 2108 RETURN 2109* 2110* End of ZDRVST2STG 2111* 2112 END 2113