1*> \brief \b ZDRVSG2STG 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 ZDRVSG2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, 12* NOUNIT, A, LDA, B, LDB, D, D2, Z, LDZ, AB, 13* BB, AP, BP, WORK, NWORK, RWORK, LRWORK, 14* IWORK, LIWORK, RESULT, INFO ) 15* 16* IMPLICIT NONE 17* 18* .. Scalar Arguments .. 19* INTEGER INFO, LDA, LDB, LDZ, LIWORK, LRWORK, NOUNIT, 20* $ NSIZES, NTYPES, NWORK 21* DOUBLE PRECISION THRESH 22* .. 23* .. Array Arguments .. 24* LOGICAL DOTYPE( * ) 25* INTEGER ISEED( 4 ), IWORK( * ), NN( * ) 26* DOUBLE PRECISION D( * ), RESULT( * ), RWORK( * ) 27* COMPLEX*16 A( LDA, * ), AB( LDA, * ), AP( * ), 28* $ B( LDB, * ), BB( LDB, * ), BP( * ), WORK( * ), 29* $ Z( LDZ, * ) 30* .. 31* 32* 33*> \par Purpose: 34* ============= 35*> 36*> \verbatim 37*> 38*> ZDRVSG2STG checks the complex Hermitian generalized eigenproblem 39*> drivers. 40*> 41*> ZHEGV computes all eigenvalues and, optionally, 42*> eigenvectors of a complex Hermitian-definite generalized 43*> eigenproblem. 44*> 45*> ZHEGVD computes all eigenvalues and, optionally, 46*> eigenvectors of a complex Hermitian-definite generalized 47*> eigenproblem using a divide and conquer algorithm. 48*> 49*> ZHEGVX computes selected eigenvalues and, optionally, 50*> eigenvectors of a complex Hermitian-definite generalized 51*> eigenproblem. 52*> 53*> ZHPGV computes all eigenvalues and, optionally, 54*> eigenvectors of a complex Hermitian-definite generalized 55*> eigenproblem in packed storage. 56*> 57*> ZHPGVD computes all eigenvalues and, optionally, 58*> eigenvectors of a complex Hermitian-definite generalized 59*> eigenproblem in packed storage using a divide and 60*> conquer algorithm. 61*> 62*> ZHPGVX computes selected eigenvalues and, optionally, 63*> eigenvectors of a complex Hermitian-definite generalized 64*> eigenproblem in packed storage. 65*> 66*> ZHBGV computes all eigenvalues and, optionally, 67*> eigenvectors of a complex Hermitian-definite banded 68*> generalized eigenproblem. 69*> 70*> ZHBGVD computes all eigenvalues and, optionally, 71*> eigenvectors of a complex Hermitian-definite banded 72*> generalized eigenproblem using a divide and conquer 73*> algorithm. 74*> 75*> ZHBGVX computes selected eigenvalues and, optionally, 76*> eigenvectors of a complex Hermitian-definite banded 77*> generalized eigenproblem. 78*> 79*> When ZDRVSG2STG is called, a number of matrix "sizes" ("n's") and a 80*> number of matrix "types" are specified. For each size ("n") 81*> and each type of matrix, one matrix A of the given type will be 82*> generated; a random well-conditioned matrix B is also generated 83*> and the pair (A,B) is used to test the drivers. 84*> 85*> For each pair (A,B), the following tests are performed: 86*> 87*> (1) ZHEGV with ITYPE = 1 and UPLO ='U': 88*> 89*> | A Z - B Z D | / ( |A| |Z| n ulp ) 90*> | D - D2 | / ( |D| ulp ) where D is computed by 91*> ZHEGV and D2 is computed by 92*> ZHEGV_2STAGE. This test is 93*> only performed for DSYGV 94*> 95*> (2) as (1) but calling ZHPGV 96*> (3) as (1) but calling ZHBGV 97*> (4) as (1) but with UPLO = 'L' 98*> (5) as (4) but calling ZHPGV 99*> (6) as (4) but calling ZHBGV 100*> 101*> (7) ZHEGV with ITYPE = 2 and UPLO ='U': 102*> 103*> | A B Z - Z D | / ( |A| |Z| n ulp ) 104*> 105*> (8) as (7) but calling ZHPGV 106*> (9) as (7) but with UPLO = 'L' 107*> (10) as (9) but calling ZHPGV 108*> 109*> (11) ZHEGV with ITYPE = 3 and UPLO ='U': 110*> 111*> | B A Z - Z D | / ( |A| |Z| n ulp ) 112*> 113*> (12) as (11) but calling ZHPGV 114*> (13) as (11) but with UPLO = 'L' 115*> (14) as (13) but calling ZHPGV 116*> 117*> ZHEGVD, ZHPGVD and ZHBGVD performed the same 14 tests. 118*> 119*> ZHEGVX, ZHPGVX and ZHBGVX performed the above 14 tests with 120*> the parameter RANGE = 'A', 'N' and 'I', respectively. 121*> 122*> The "sizes" are specified by an array NN(1:NSIZES); the value of 123*> each element NN(j) specifies one size. 124*> The "types" are specified by a logical array DOTYPE( 1:NTYPES ); 125*> if DOTYPE(j) is .TRUE., then matrix type "j" will be generated. 126*> This type is used for the matrix A which has half-bandwidth KA. 127*> B is generated as a well-conditioned positive definite matrix 128*> with half-bandwidth KB (<= KA). 129*> Currently, the list of possible types for A is: 130*> 131*> (1) The zero matrix. 132*> (2) The identity matrix. 133*> 134*> (3) A diagonal matrix with evenly spaced entries 135*> 1, ..., ULP and random signs. 136*> (ULP = (first number larger than 1) - 1 ) 137*> (4) A diagonal matrix with geometrically spaced entries 138*> 1, ..., ULP and random signs. 139*> (5) A diagonal matrix with "clustered" entries 1, ULP, ..., ULP 140*> and random signs. 141*> 142*> (6) Same as (4), but multiplied by SQRT( overflow threshold ) 143*> (7) Same as (4), but multiplied by SQRT( underflow threshold ) 144*> 145*> (8) A matrix of the form U* D U, where U is unitary and 146*> D has evenly spaced entries 1, ..., ULP with random signs 147*> on the diagonal. 148*> 149*> (9) A matrix of the form U* D U, where U is unitary and 150*> D has geometrically spaced entries 1, ..., ULP with random 151*> signs on the diagonal. 152*> 153*> (10) A matrix of the form U* D U, where U is unitary and 154*> D has "clustered" entries 1, ULP,..., ULP with random 155*> signs on the diagonal. 156*> 157*> (11) Same as (8), but multiplied by SQRT( overflow threshold ) 158*> (12) Same as (8), but multiplied by SQRT( underflow threshold ) 159*> 160*> (13) Hermitian matrix with random entries chosen from (-1,1). 161*> (14) Same as (13), but multiplied by SQRT( overflow threshold ) 162*> (15) Same as (13), but multiplied by SQRT( underflow threshold ) 163*> 164*> (16) Same as (8), but with KA = 1 and KB = 1 165*> (17) Same as (8), but with KA = 2 and KB = 1 166*> (18) Same as (8), but with KA = 2 and KB = 2 167*> (19) Same as (8), but with KA = 3 and KB = 1 168*> (20) Same as (8), but with KA = 3 and KB = 2 169*> (21) Same as (8), but with KA = 3 and KB = 3 170*> \endverbatim 171* 172* Arguments: 173* ========== 174* 175*> \verbatim 176*> NSIZES INTEGER 177*> The number of sizes of matrices to use. If it is zero, 178*> ZDRVSG2STG does nothing. It must be at least zero. 179*> Not modified. 180*> 181*> NN INTEGER array, dimension (NSIZES) 182*> An array containing the sizes to be used for the matrices. 183*> Zero values will be skipped. The values must be at least 184*> zero. 185*> Not modified. 186*> 187*> NTYPES INTEGER 188*> The number of elements in DOTYPE. If it is zero, ZDRVSG2STG 189*> does nothing. It must be at least zero. If it is MAXTYP+1 190*> and NSIZES is 1, then an additional type, MAXTYP+1 is 191*> defined, which is to use whatever matrix is in A. This 192*> is only useful if DOTYPE(1:MAXTYP) is .FALSE. and 193*> DOTYPE(MAXTYP+1) is .TRUE. . 194*> Not modified. 195*> 196*> DOTYPE LOGICAL array, dimension (NTYPES) 197*> If DOTYPE(j) is .TRUE., then for each size in NN a 198*> matrix of that size and of type j will be generated. 199*> If NTYPES is smaller than the maximum number of types 200*> defined (PARAMETER MAXTYP), then types NTYPES+1 through 201*> MAXTYP will not be generated. If NTYPES is larger 202*> than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES) 203*> will be ignored. 204*> Not modified. 205*> 206*> ISEED INTEGER array, dimension (4) 207*> On entry ISEED specifies the seed of the random number 208*> generator. The array elements should be between 0 and 4095; 209*> if not they will be reduced mod 4096. Also, ISEED(4) must 210*> be odd. The random number generator uses a linear 211*> congruential sequence limited to small integers, and so 212*> should produce machine independent random numbers. The 213*> values of ISEED are changed on exit, and can be used in the 214*> next call to ZDRVSG2STG to continue the same random number 215*> sequence. 216*> Modified. 217*> 218*> THRESH DOUBLE PRECISION 219*> A test will count as "failed" if the "error", computed as 220*> described above, exceeds THRESH. Note that the error 221*> is scaled to be O(1), so THRESH should be a reasonably 222*> small multiple of 1, e.g., 10 or 100. In particular, 223*> it should not depend on the precision (single vs. double) 224*> or the size of the matrix. It must be at least zero. 225*> Not modified. 226*> 227*> NOUNIT INTEGER 228*> The FORTRAN unit number for printing out error messages 229*> (e.g., if a routine returns IINFO not equal to 0.) 230*> Not modified. 231*> 232*> A COMPLEX*16 array, dimension (LDA , max(NN)) 233*> Used to hold the matrix whose eigenvalues are to be 234*> computed. On exit, A contains the last matrix actually 235*> used. 236*> Modified. 237*> 238*> LDA INTEGER 239*> The leading dimension of A. It must be at 240*> least 1 and at least max( NN ). 241*> Not modified. 242*> 243*> B COMPLEX*16 array, dimension (LDB , max(NN)) 244*> Used to hold the Hermitian positive definite matrix for 245*> the generailzed problem. 246*> On exit, B contains the last matrix actually 247*> used. 248*> Modified. 249*> 250*> LDB INTEGER 251*> The leading dimension of B. It must be at 252*> least 1 and at least max( NN ). 253*> Not modified. 254*> 255*> D DOUBLE PRECISION array, dimension (max(NN)) 256*> The eigenvalues of A. On exit, the eigenvalues in D 257*> correspond with the matrix in A. 258*> Modified. 259*> 260*> Z COMPLEX*16 array, dimension (LDZ, max(NN)) 261*> The matrix of eigenvectors. 262*> Modified. 263*> 264*> LDZ INTEGER 265*> The leading dimension of ZZ. It must be at least 1 and 266*> at least max( NN ). 267*> Not modified. 268*> 269*> AB COMPLEX*16 array, dimension (LDA, max(NN)) 270*> Workspace. 271*> Modified. 272*> 273*> BB COMPLEX*16 array, dimension (LDB, max(NN)) 274*> Workspace. 275*> Modified. 276*> 277*> AP COMPLEX*16 array, dimension (max(NN)**2) 278*> Workspace. 279*> Modified. 280*> 281*> BP COMPLEX*16 array, dimension (max(NN)**2) 282*> Workspace. 283*> Modified. 284*> 285*> WORK COMPLEX*16 array, dimension (NWORK) 286*> Workspace. 287*> Modified. 288*> 289*> NWORK INTEGER 290*> The number of entries in WORK. This must be at least 291*> 2*N + N**2 where N = max( NN(j), 2 ). 292*> Not modified. 293*> 294*> RWORK DOUBLE PRECISION array, dimension (LRWORK) 295*> Workspace. 296*> Modified. 297*> 298*> LRWORK INTEGER 299*> The number of entries in RWORK. This must be at least 300*> max( 7*N, 1 + 4*N + 2*N*lg(N) + 3*N**2 ) where 301*> N = max( NN(j) ) and lg( N ) = smallest integer k such 302*> that 2**k >= N . 303*> Not modified. 304*> 305*> IWORK INTEGER array, dimension (LIWORK)) 306*> Workspace. 307*> Modified. 308*> 309*> LIWORK INTEGER 310*> The number of entries in IWORK. This must be at least 311*> 2 + 5*max( NN(j) ). 312*> Not modified. 313*> 314*> RESULT DOUBLE PRECISION array, dimension (70) 315*> The values computed by the 70 tests described above. 316*> Modified. 317*> 318*> INFO INTEGER 319*> If 0, then everything ran OK. 320*> -1: NSIZES < 0 321*> -2: Some NN(j) < 0 322*> -3: NTYPES < 0 323*> -5: THRESH < 0 324*> -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ). 325*> -16: LDZ < 1 or LDZ < NMAX. 326*> -21: NWORK too small. 327*> -23: LRWORK too small. 328*> -25: LIWORK too small. 329*> If ZLATMR, CLATMS, ZHEGV, ZHPGV, ZHBGV, CHEGVD, CHPGVD, 330*> ZHPGVD, ZHEGVX, CHPGVX, ZHBGVX returns an error code, 331*> the absolute value of it is returned. 332*> Modified. 333*> 334*>----------------------------------------------------------------------- 335*> 336*> Some Local Variables and Parameters: 337*> ---- ----- --------- --- ---------- 338*> ZERO, ONE Real 0 and 1. 339*> MAXTYP The number of types defined. 340*> NTEST The number of tests that have been run 341*> on this matrix. 342*> NTESTT The total number of tests for this call. 343*> NMAX Largest value in NN. 344*> NMATS The number of matrices generated so far. 345*> NERRS The number of tests which have exceeded THRESH 346*> so far (computed by DLAFTS). 347*> COND, IMODE Values to be passed to the matrix generators. 348*> ANORM Norm of A; passed to matrix generators. 349*> 350*> OVFL, UNFL Overflow and underflow thresholds. 351*> ULP, ULPINV Finest relative precision and its inverse. 352*> RTOVFL, RTUNFL Square roots of the previous 2 values. 353*> The following four arrays decode JTYPE: 354*> KTYPE(j) The general type (1-10) for type "j". 355*> KMODE(j) The MODE value to be passed to the matrix 356*> generator for type "j". 357*> KMAGN(j) The order of magnitude ( O(1), 358*> O(overflow^(1/2) ), O(underflow^(1/2) ) 359*> \endverbatim 360* 361* Authors: 362* ======== 363* 364*> \author Univ. of Tennessee 365*> \author Univ. of California Berkeley 366*> \author Univ. of Colorado Denver 367*> \author NAG Ltd. 368* 369*> \ingroup complex16_eig 370* 371* ===================================================================== 372 SUBROUTINE ZDRVSG2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, 373 $ NOUNIT, A, LDA, B, LDB, D, D2, Z, LDZ, AB, 374 $ BB, AP, BP, WORK, NWORK, RWORK, LRWORK, 375 $ IWORK, LIWORK, RESULT, INFO ) 376* 377 IMPLICIT NONE 378* 379* -- LAPACK test routine -- 380* -- LAPACK is a software package provided by Univ. of Tennessee, -- 381* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 382* 383* .. Scalar Arguments .. 384 INTEGER INFO, LDA, LDB, LDZ, LIWORK, LRWORK, NOUNIT, 385 $ NSIZES, NTYPES, NWORK 386 DOUBLE PRECISION THRESH 387* .. 388* .. Array Arguments .. 389 LOGICAL DOTYPE( * ) 390 INTEGER ISEED( 4 ), IWORK( * ), NN( * ) 391 DOUBLE PRECISION D( * ), D2( * ), RESULT( * ), RWORK( * ) 392 COMPLEX*16 A( LDA, * ), AB( LDA, * ), AP( * ), 393 $ B( LDB, * ), BB( LDB, * ), BP( * ), WORK( * ), 394 $ Z( LDZ, * ) 395* .. 396* 397* ===================================================================== 398* 399* .. Parameters .. 400 DOUBLE PRECISION ZERO, ONE, TEN 401 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TEN = 10.0D+0 ) 402 COMPLEX*16 CZERO, CONE 403 PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ), 404 $ CONE = ( 1.0D+0, 0.0D+0 ) ) 405 INTEGER MAXTYP 406 PARAMETER ( MAXTYP = 21 ) 407* .. 408* .. Local Scalars .. 409 LOGICAL BADNN 410 CHARACTER UPLO 411 INTEGER I, IBTYPE, IBUPLO, IINFO, IJ, IL, IMODE, ITEMP, 412 $ ITYPE, IU, J, JCOL, JSIZE, JTYPE, KA, KA9, KB, 413 $ KB9, M, MTYPES, N, NERRS, NMATS, NMAX, NTEST, 414 $ NTESTT 415 DOUBLE PRECISION ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL, 416 $ RTUNFL, ULP, ULPINV, UNFL, VL, VU, TEMP1, TEMP2 417* .. 418* .. Local Arrays .. 419 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ), 420 $ KMAGN( MAXTYP ), KMODE( MAXTYP ), 421 $ KTYPE( MAXTYP ) 422* .. 423* .. External Functions .. 424 LOGICAL LSAME 425 DOUBLE PRECISION DLAMCH, DLARND 426 EXTERNAL LSAME, DLAMCH, DLARND 427* .. 428* .. External Subroutines .. 429 EXTERNAL DLABAD, DLAFTS, DLASUM, XERBLA, ZHBGV, ZHBGVD, 430 $ ZHBGVX, ZHEGV, ZHEGVD, ZHEGVX, ZHPGV, ZHPGVD, 431 $ ZHPGVX, ZLACPY, ZLASET, ZLATMR, ZLATMS, ZSGT01, 432 $ ZHEGV_2STAGE 433* .. 434* .. Intrinsic Functions .. 435 INTRINSIC ABS, DBLE, MAX, MIN, SQRT 436* .. 437* .. Data statements .. 438 DATA KTYPE / 1, 2, 5*4, 5*5, 3*8, 6*9 / 439 DATA KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1, 440 $ 2, 3, 6*1 / 441 DATA KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0, 442 $ 0, 0, 6*4 / 443* .. 444* .. Executable Statements .. 445* 446* 1) Check for errors 447* 448 NTESTT = 0 449 INFO = 0 450* 451 BADNN = .FALSE. 452 NMAX = 0 453 DO 10 J = 1, NSIZES 454 NMAX = MAX( NMAX, NN( J ) ) 455 IF( NN( J ).LT.0 ) 456 $ BADNN = .TRUE. 457 10 CONTINUE 458* 459* Check for errors 460* 461 IF( NSIZES.LT.0 ) THEN 462 INFO = -1 463 ELSE IF( BADNN ) THEN 464 INFO = -2 465 ELSE IF( NTYPES.LT.0 ) THEN 466 INFO = -3 467 ELSE IF( LDA.LE.1 .OR. LDA.LT.NMAX ) THEN 468 INFO = -9 469 ELSE IF( LDZ.LE.1 .OR. LDZ.LT.NMAX ) THEN 470 INFO = -16 471 ELSE IF( 2*MAX( NMAX, 2 )**2.GT.NWORK ) THEN 472 INFO = -21 473 ELSE IF( 2*MAX( NMAX, 2 )**2.GT.LRWORK ) THEN 474 INFO = -23 475 ELSE IF( 2*MAX( NMAX, 2 )**2.GT.LIWORK ) THEN 476 INFO = -25 477 END IF 478* 479 IF( INFO.NE.0 ) THEN 480 CALL XERBLA( 'ZDRVSG2STG', -INFO ) 481 RETURN 482 END IF 483* 484* Quick return if possible 485* 486 IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 ) 487 $ RETURN 488* 489* More Important constants 490* 491 UNFL = DLAMCH( 'Safe minimum' ) 492 OVFL = DLAMCH( 'Overflow' ) 493 CALL DLABAD( UNFL, OVFL ) 494 ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) 495 ULPINV = ONE / ULP 496 RTUNFL = SQRT( UNFL ) 497 RTOVFL = SQRT( OVFL ) 498* 499 DO 20 I = 1, 4 500 ISEED2( I ) = ISEED( I ) 501 20 CONTINUE 502* 503* Loop over sizes, types 504* 505 NERRS = 0 506 NMATS = 0 507* 508 DO 650 JSIZE = 1, NSIZES 509 N = NN( JSIZE ) 510 ANINV = ONE / DBLE( MAX( 1, N ) ) 511* 512 IF( NSIZES.NE.1 ) THEN 513 MTYPES = MIN( MAXTYP, NTYPES ) 514 ELSE 515 MTYPES = MIN( MAXTYP+1, NTYPES ) 516 END IF 517* 518 KA9 = 0 519 KB9 = 0 520 DO 640 JTYPE = 1, MTYPES 521 IF( .NOT.DOTYPE( JTYPE ) ) 522 $ GO TO 640 523 NMATS = NMATS + 1 524 NTEST = 0 525* 526 DO 30 J = 1, 4 527 IOLDSD( J ) = ISEED( J ) 528 30 CONTINUE 529* 530* 2) Compute "A" 531* 532* Control parameters: 533* 534* KMAGN KMODE KTYPE 535* =1 O(1) clustered 1 zero 536* =2 large clustered 2 identity 537* =3 small exponential (none) 538* =4 arithmetic diagonal, w/ eigenvalues 539* =5 random log hermitian, w/ eigenvalues 540* =6 random (none) 541* =7 random diagonal 542* =8 random hermitian 543* =9 banded, w/ eigenvalues 544* 545 IF( MTYPES.GT.MAXTYP ) 546 $ GO TO 90 547* 548 ITYPE = KTYPE( JTYPE ) 549 IMODE = KMODE( JTYPE ) 550* 551* Compute norm 552* 553 GO TO ( 40, 50, 60 )KMAGN( JTYPE ) 554* 555 40 CONTINUE 556 ANORM = ONE 557 GO TO 70 558* 559 50 CONTINUE 560 ANORM = ( RTOVFL*ULP )*ANINV 561 GO TO 70 562* 563 60 CONTINUE 564 ANORM = RTUNFL*N*ULPINV 565 GO TO 70 566* 567 70 CONTINUE 568* 569 IINFO = 0 570 COND = ULPINV 571* 572* Special Matrices -- Identity & Jordan block 573* 574 IF( ITYPE.EQ.1 ) THEN 575* 576* Zero 577* 578 KA = 0 579 KB = 0 580 CALL ZLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA ) 581* 582 ELSE IF( ITYPE.EQ.2 ) THEN 583* 584* Identity 585* 586 KA = 0 587 KB = 0 588 CALL ZLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA ) 589 DO 80 JCOL = 1, N 590 A( JCOL, JCOL ) = ANORM 591 80 CONTINUE 592* 593 ELSE IF( ITYPE.EQ.4 ) THEN 594* 595* Diagonal Matrix, [Eigen]values Specified 596* 597 KA = 0 598 KB = 0 599 CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND, 600 $ ANORM, 0, 0, 'N', A, LDA, WORK, IINFO ) 601* 602 ELSE IF( ITYPE.EQ.5 ) THEN 603* 604* Hermitian, eigenvalues specified 605* 606 KA = MAX( 0, N-1 ) 607 KB = KA 608 CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND, 609 $ ANORM, N, N, 'N', A, LDA, WORK, IINFO ) 610* 611 ELSE IF( ITYPE.EQ.7 ) THEN 612* 613* Diagonal, random eigenvalues 614* 615 KA = 0 616 KB = 0 617 CALL ZLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE, 618 $ 'T', 'N', WORK( N+1 ), 1, ONE, 619 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0, 620 $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO ) 621* 622 ELSE IF( ITYPE.EQ.8 ) THEN 623* 624* Hermitian, random eigenvalues 625* 626 KA = MAX( 0, N-1 ) 627 KB = KA 628 CALL ZLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE, 629 $ 'T', 'N', WORK( N+1 ), 1, ONE, 630 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N, 631 $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO ) 632* 633 ELSE IF( ITYPE.EQ.9 ) THEN 634* 635* Hermitian banded, eigenvalues specified 636* 637* The following values are used for the half-bandwidths: 638* 639* ka = 1 kb = 1 640* ka = 2 kb = 1 641* ka = 2 kb = 2 642* ka = 3 kb = 1 643* ka = 3 kb = 2 644* ka = 3 kb = 3 645* 646 KB9 = KB9 + 1 647 IF( KB9.GT.KA9 ) THEN 648 KA9 = KA9 + 1 649 KB9 = 1 650 END IF 651 KA = MAX( 0, MIN( N-1, KA9 ) ) 652 KB = MAX( 0, MIN( N-1, KB9 ) ) 653 CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND, 654 $ ANORM, KA, KA, 'N', A, LDA, WORK, IINFO ) 655* 656 ELSE 657* 658 IINFO = 1 659 END IF 660* 661 IF( IINFO.NE.0 ) THEN 662 WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE, 663 $ IOLDSD 664 INFO = ABS( IINFO ) 665 RETURN 666 END IF 667* 668 90 CONTINUE 669* 670 ABSTOL = UNFL + UNFL 671 IF( N.LE.1 ) THEN 672 IL = 1 673 IU = N 674 ELSE 675 IL = 1 + INT( ( N-1 )*DLARND( 1, ISEED2 ) ) 676 IU = 1 + INT( ( N-1 )*DLARND( 1, ISEED2 ) ) 677 IF( IL.GT.IU ) THEN 678 ITEMP = IL 679 IL = IU 680 IU = ITEMP 681 END IF 682 END IF 683* 684* 3) Call ZHEGV, ZHPGV, ZHBGV, CHEGVD, CHPGVD, CHBGVD, 685* ZHEGVX, ZHPGVX and ZHBGVX, do tests. 686* 687* loop over the three generalized problems 688* IBTYPE = 1: A*x = (lambda)*B*x 689* IBTYPE = 2: A*B*x = (lambda)*x 690* IBTYPE = 3: B*A*x = (lambda)*x 691* 692 DO 630 IBTYPE = 1, 3 693* 694* loop over the setting UPLO 695* 696 DO 620 IBUPLO = 1, 2 697 IF( IBUPLO.EQ.1 ) 698 $ UPLO = 'U' 699 IF( IBUPLO.EQ.2 ) 700 $ UPLO = 'L' 701* 702* Generate random well-conditioned positive definite 703* matrix B, of bandwidth not greater than that of A. 704* 705 CALL ZLATMS( N, N, 'U', ISEED, 'P', RWORK, 5, TEN, 706 $ ONE, KB, KB, UPLO, B, LDB, WORK( N+1 ), 707 $ IINFO ) 708* 709* Test ZHEGV 710* 711 NTEST = NTEST + 1 712* 713 CALL ZLACPY( ' ', N, N, A, LDA, Z, LDZ ) 714 CALL ZLACPY( UPLO, N, N, B, LDB, BB, LDB ) 715* 716 CALL ZHEGV( IBTYPE, 'V', UPLO, N, Z, LDZ, BB, LDB, D, 717 $ WORK, NWORK, RWORK, IINFO ) 718 IF( IINFO.NE.0 ) THEN 719 WRITE( NOUNIT, FMT = 9999 )'ZHEGV(V,' // UPLO // 720 $ ')', IINFO, N, JTYPE, IOLDSD 721 INFO = ABS( IINFO ) 722 IF( IINFO.LT.0 ) THEN 723 RETURN 724 ELSE 725 RESULT( NTEST ) = ULPINV 726 GO TO 100 727 END IF 728 END IF 729* 730* Do Test 731* 732 CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z, 733 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) ) 734* 735* Test ZHEGV_2STAGE 736* 737 NTEST = NTEST + 1 738* 739 CALL ZLACPY( ' ', N, N, A, LDA, Z, LDZ ) 740 CALL ZLACPY( UPLO, N, N, B, LDB, BB, LDB ) 741* 742 CALL ZHEGV_2STAGE( IBTYPE, 'N', UPLO, N, Z, LDZ, 743 $ BB, LDB, D2, WORK, NWORK, RWORK, 744 $ IINFO ) 745 IF( IINFO.NE.0 ) THEN 746 WRITE( NOUNIT, FMT = 9999 ) 747 $ 'ZHEGV_2STAGE(V,' // UPLO // 748 $ ')', IINFO, N, JTYPE, IOLDSD 749 INFO = ABS( IINFO ) 750 IF( IINFO.LT.0 ) THEN 751 RETURN 752 ELSE 753 RESULT( NTEST ) = ULPINV 754 GO TO 100 755 END IF 756 END IF 757* 758* Do Test 759* 760C CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z, 761C $ LDZ, D, WORK, RWORK, RESULT( NTEST ) ) 762* 763* Do Tests | D1 - D2 | / ( |D1| ulp ) 764* D1 computed using the standard 1-stage reduction as reference 765* D2 computed using the 2-stage reduction 766* 767 TEMP1 = ZERO 768 TEMP2 = ZERO 769 DO 151 J = 1, N 770 TEMP1 = MAX( TEMP1, ABS( D( J ) ), 771 $ ABS( D2( J ) ) ) 772 TEMP2 = MAX( TEMP2, ABS( D( J )-D2( J ) ) ) 773 151 CONTINUE 774* 775 RESULT( NTEST ) = TEMP2 / 776 $ MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) ) 777* 778* Test ZHEGVD 779* 780 NTEST = NTEST + 1 781* 782 CALL ZLACPY( ' ', N, N, A, LDA, Z, LDZ ) 783 CALL ZLACPY( UPLO, N, N, B, LDB, BB, LDB ) 784* 785 CALL ZHEGVD( IBTYPE, 'V', UPLO, N, Z, LDZ, BB, LDB, D, 786 $ WORK, NWORK, RWORK, LRWORK, IWORK, 787 $ LIWORK, IINFO ) 788 IF( IINFO.NE.0 ) THEN 789 WRITE( NOUNIT, FMT = 9999 )'ZHEGVD(V,' // UPLO // 790 $ ')', IINFO, N, JTYPE, IOLDSD 791 INFO = ABS( IINFO ) 792 IF( IINFO.LT.0 ) THEN 793 RETURN 794 ELSE 795 RESULT( NTEST ) = ULPINV 796 GO TO 100 797 END IF 798 END IF 799* 800* Do Test 801* 802 CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z, 803 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) ) 804* 805* Test ZHEGVX 806* 807 NTEST = NTEST + 1 808* 809 CALL ZLACPY( ' ', N, N, A, LDA, AB, LDA ) 810 CALL ZLACPY( UPLO, N, N, B, LDB, BB, LDB ) 811* 812 CALL ZHEGVX( IBTYPE, 'V', 'A', UPLO, N, AB, LDA, BB, 813 $ LDB, VL, VU, IL, IU, ABSTOL, M, D, Z, 814 $ LDZ, WORK, NWORK, RWORK, IWORK( N+1 ), 815 $ IWORK, IINFO ) 816 IF( IINFO.NE.0 ) THEN 817 WRITE( NOUNIT, FMT = 9999 )'ZHEGVX(V,A' // UPLO // 818 $ ')', IINFO, N, JTYPE, IOLDSD 819 INFO = ABS( IINFO ) 820 IF( IINFO.LT.0 ) THEN 821 RETURN 822 ELSE 823 RESULT( NTEST ) = ULPINV 824 GO TO 100 825 END IF 826 END IF 827* 828* Do Test 829* 830 CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z, 831 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) ) 832* 833 NTEST = NTEST + 1 834* 835 CALL ZLACPY( ' ', N, N, A, LDA, AB, LDA ) 836 CALL ZLACPY( UPLO, N, N, B, LDB, BB, LDB ) 837* 838* since we do not know the exact eigenvalues of this 839* eigenpair, we just set VL and VU as constants. 840* It is quite possible that there are no eigenvalues 841* in this interval. 842* 843 VL = ZERO 844 VU = ANORM 845 CALL ZHEGVX( IBTYPE, 'V', 'V', UPLO, N, AB, LDA, BB, 846 $ LDB, VL, VU, IL, IU, ABSTOL, M, D, Z, 847 $ LDZ, WORK, NWORK, RWORK, IWORK( N+1 ), 848 $ IWORK, IINFO ) 849 IF( IINFO.NE.0 ) THEN 850 WRITE( NOUNIT, FMT = 9999 )'ZHEGVX(V,V,' // 851 $ UPLO // ')', IINFO, N, JTYPE, IOLDSD 852 INFO = ABS( IINFO ) 853 IF( IINFO.LT.0 ) THEN 854 RETURN 855 ELSE 856 RESULT( NTEST ) = ULPINV 857 GO TO 100 858 END IF 859 END IF 860* 861* Do Test 862* 863 CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z, 864 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) ) 865* 866 NTEST = NTEST + 1 867* 868 CALL ZLACPY( ' ', N, N, A, LDA, AB, LDA ) 869 CALL ZLACPY( UPLO, N, N, B, LDB, BB, LDB ) 870* 871 CALL ZHEGVX( IBTYPE, 'V', 'I', UPLO, N, AB, LDA, BB, 872 $ LDB, VL, VU, IL, IU, ABSTOL, M, D, Z, 873 $ LDZ, WORK, NWORK, RWORK, IWORK( N+1 ), 874 $ IWORK, IINFO ) 875 IF( IINFO.NE.0 ) THEN 876 WRITE( NOUNIT, FMT = 9999 )'ZHEGVX(V,I,' // 877 $ UPLO // ')', 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 100 884 END IF 885 END IF 886* 887* Do Test 888* 889 CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z, 890 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) ) 891* 892 100 CONTINUE 893* 894* Test ZHPGV 895* 896 NTEST = NTEST + 1 897* 898* Copy the matrices into packed storage. 899* 900 IF( LSAME( UPLO, 'U' ) ) THEN 901 IJ = 1 902 DO 120 J = 1, N 903 DO 110 I = 1, J 904 AP( IJ ) = A( I, J ) 905 BP( IJ ) = B( I, J ) 906 IJ = IJ + 1 907 110 CONTINUE 908 120 CONTINUE 909 ELSE 910 IJ = 1 911 DO 140 J = 1, N 912 DO 130 I = J, N 913 AP( IJ ) = A( I, J ) 914 BP( IJ ) = B( I, J ) 915 IJ = IJ + 1 916 130 CONTINUE 917 140 CONTINUE 918 END IF 919* 920 CALL ZHPGV( IBTYPE, 'V', UPLO, N, AP, BP, D, Z, LDZ, 921 $ WORK, RWORK, IINFO ) 922 IF( IINFO.NE.0 ) THEN 923 WRITE( NOUNIT, FMT = 9999 )'ZHPGV(V,' // UPLO // 924 $ ')', IINFO, N, JTYPE, IOLDSD 925 INFO = ABS( IINFO ) 926 IF( IINFO.LT.0 ) THEN 927 RETURN 928 ELSE 929 RESULT( NTEST ) = ULPINV 930 GO TO 310 931 END IF 932 END IF 933* 934* Do Test 935* 936 CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z, 937 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) ) 938* 939* Test ZHPGVD 940* 941 NTEST = NTEST + 1 942* 943* Copy the matrices into packed storage. 944* 945 IF( LSAME( UPLO, 'U' ) ) THEN 946 IJ = 1 947 DO 160 J = 1, N 948 DO 150 I = 1, J 949 AP( IJ ) = A( I, J ) 950 BP( IJ ) = B( I, J ) 951 IJ = IJ + 1 952 150 CONTINUE 953 160 CONTINUE 954 ELSE 955 IJ = 1 956 DO 180 J = 1, N 957 DO 170 I = J, N 958 AP( IJ ) = A( I, J ) 959 BP( IJ ) = B( I, J ) 960 IJ = IJ + 1 961 170 CONTINUE 962 180 CONTINUE 963 END IF 964* 965 CALL ZHPGVD( IBTYPE, 'V', UPLO, N, AP, BP, D, Z, LDZ, 966 $ WORK, NWORK, RWORK, LRWORK, IWORK, 967 $ LIWORK, IINFO ) 968 IF( IINFO.NE.0 ) THEN 969 WRITE( NOUNIT, FMT = 9999 )'ZHPGVD(V,' // UPLO // 970 $ ')', IINFO, N, JTYPE, IOLDSD 971 INFO = ABS( IINFO ) 972 IF( IINFO.LT.0 ) THEN 973 RETURN 974 ELSE 975 RESULT( NTEST ) = ULPINV 976 GO TO 310 977 END IF 978 END IF 979* 980* Do Test 981* 982 CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z, 983 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) ) 984* 985* Test ZHPGVX 986* 987 NTEST = NTEST + 1 988* 989* Copy the matrices into packed storage. 990* 991 IF( LSAME( UPLO, 'U' ) ) THEN 992 IJ = 1 993 DO 200 J = 1, N 994 DO 190 I = 1, J 995 AP( IJ ) = A( I, J ) 996 BP( IJ ) = B( I, J ) 997 IJ = IJ + 1 998 190 CONTINUE 999 200 CONTINUE 1000 ELSE 1001 IJ = 1 1002 DO 220 J = 1, N 1003 DO 210 I = J, N 1004 AP( IJ ) = A( I, J ) 1005 BP( IJ ) = B( I, J ) 1006 IJ = IJ + 1 1007 210 CONTINUE 1008 220 CONTINUE 1009 END IF 1010* 1011 CALL ZHPGVX( IBTYPE, 'V', 'A', UPLO, N, AP, BP, VL, 1012 $ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK, 1013 $ RWORK, IWORK( N+1 ), IWORK, INFO ) 1014 IF( IINFO.NE.0 ) THEN 1015 WRITE( NOUNIT, FMT = 9999 )'ZHPGVX(V,A' // UPLO // 1016 $ ')', IINFO, N, JTYPE, IOLDSD 1017 INFO = ABS( IINFO ) 1018 IF( IINFO.LT.0 ) THEN 1019 RETURN 1020 ELSE 1021 RESULT( NTEST ) = ULPINV 1022 GO TO 310 1023 END IF 1024 END IF 1025* 1026* Do Test 1027* 1028 CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z, 1029 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) ) 1030* 1031 NTEST = NTEST + 1 1032* 1033* Copy the matrices into packed storage. 1034* 1035 IF( LSAME( UPLO, 'U' ) ) THEN 1036 IJ = 1 1037 DO 240 J = 1, N 1038 DO 230 I = 1, J 1039 AP( IJ ) = A( I, J ) 1040 BP( IJ ) = B( I, J ) 1041 IJ = IJ + 1 1042 230 CONTINUE 1043 240 CONTINUE 1044 ELSE 1045 IJ = 1 1046 DO 260 J = 1, N 1047 DO 250 I = J, N 1048 AP( IJ ) = A( I, J ) 1049 BP( IJ ) = B( I, J ) 1050 IJ = IJ + 1 1051 250 CONTINUE 1052 260 CONTINUE 1053 END IF 1054* 1055 VL = ZERO 1056 VU = ANORM 1057 CALL ZHPGVX( IBTYPE, 'V', 'V', UPLO, N, AP, BP, VL, 1058 $ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK, 1059 $ RWORK, IWORK( N+1 ), IWORK, INFO ) 1060 IF( IINFO.NE.0 ) THEN 1061 WRITE( NOUNIT, FMT = 9999 )'ZHPGVX(V,V' // UPLO // 1062 $ ')', IINFO, N, JTYPE, IOLDSD 1063 INFO = ABS( IINFO ) 1064 IF( IINFO.LT.0 ) THEN 1065 RETURN 1066 ELSE 1067 RESULT( NTEST ) = ULPINV 1068 GO TO 310 1069 END IF 1070 END IF 1071* 1072* Do Test 1073* 1074 CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z, 1075 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) ) 1076* 1077 NTEST = NTEST + 1 1078* 1079* Copy the matrices into packed storage. 1080* 1081 IF( LSAME( UPLO, 'U' ) ) THEN 1082 IJ = 1 1083 DO 280 J = 1, N 1084 DO 270 I = 1, J 1085 AP( IJ ) = A( I, J ) 1086 BP( IJ ) = B( I, J ) 1087 IJ = IJ + 1 1088 270 CONTINUE 1089 280 CONTINUE 1090 ELSE 1091 IJ = 1 1092 DO 300 J = 1, N 1093 DO 290 I = J, N 1094 AP( IJ ) = A( I, J ) 1095 BP( IJ ) = B( I, J ) 1096 IJ = IJ + 1 1097 290 CONTINUE 1098 300 CONTINUE 1099 END IF 1100* 1101 CALL ZHPGVX( IBTYPE, 'V', 'I', UPLO, N, AP, BP, VL, 1102 $ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK, 1103 $ RWORK, IWORK( N+1 ), IWORK, INFO ) 1104 IF( IINFO.NE.0 ) THEN 1105 WRITE( NOUNIT, FMT = 9999 )'ZHPGVX(V,I' // UPLO // 1106 $ ')', IINFO, N, JTYPE, IOLDSD 1107 INFO = ABS( IINFO ) 1108 IF( IINFO.LT.0 ) THEN 1109 RETURN 1110 ELSE 1111 RESULT( NTEST ) = ULPINV 1112 GO TO 310 1113 END IF 1114 END IF 1115* 1116* Do Test 1117* 1118 CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z, 1119 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) ) 1120* 1121 310 CONTINUE 1122* 1123 IF( IBTYPE.EQ.1 ) THEN 1124* 1125* TEST ZHBGV 1126* 1127 NTEST = NTEST + 1 1128* 1129* Copy the matrices into band storage. 1130* 1131 IF( LSAME( UPLO, 'U' ) ) THEN 1132 DO 340 J = 1, N 1133 DO 320 I = MAX( 1, J-KA ), J 1134 AB( KA+1+I-J, J ) = A( I, J ) 1135 320 CONTINUE 1136 DO 330 I = MAX( 1, J-KB ), J 1137 BB( KB+1+I-J, J ) = B( I, J ) 1138 330 CONTINUE 1139 340 CONTINUE 1140 ELSE 1141 DO 370 J = 1, N 1142 DO 350 I = J, MIN( N, J+KA ) 1143 AB( 1+I-J, J ) = A( I, J ) 1144 350 CONTINUE 1145 DO 360 I = J, MIN( N, J+KB ) 1146 BB( 1+I-J, J ) = B( I, J ) 1147 360 CONTINUE 1148 370 CONTINUE 1149 END IF 1150* 1151 CALL ZHBGV( 'V', UPLO, N, KA, KB, AB, LDA, BB, LDB, 1152 $ D, Z, LDZ, WORK, RWORK, IINFO ) 1153 IF( IINFO.NE.0 ) THEN 1154 WRITE( NOUNIT, FMT = 9999 )'ZHBGV(V,' // 1155 $ UPLO // ')', IINFO, N, JTYPE, IOLDSD 1156 INFO = ABS( IINFO ) 1157 IF( IINFO.LT.0 ) THEN 1158 RETURN 1159 ELSE 1160 RESULT( NTEST ) = ULPINV 1161 GO TO 620 1162 END IF 1163 END IF 1164* 1165* Do Test 1166* 1167 CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z, 1168 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) ) 1169* 1170* TEST ZHBGVD 1171* 1172 NTEST = NTEST + 1 1173* 1174* Copy the matrices into band storage. 1175* 1176 IF( LSAME( UPLO, 'U' ) ) THEN 1177 DO 400 J = 1, N 1178 DO 380 I = MAX( 1, J-KA ), J 1179 AB( KA+1+I-J, J ) = A( I, J ) 1180 380 CONTINUE 1181 DO 390 I = MAX( 1, J-KB ), J 1182 BB( KB+1+I-J, J ) = B( I, J ) 1183 390 CONTINUE 1184 400 CONTINUE 1185 ELSE 1186 DO 430 J = 1, N 1187 DO 410 I = J, MIN( N, J+KA ) 1188 AB( 1+I-J, J ) = A( I, J ) 1189 410 CONTINUE 1190 DO 420 I = J, MIN( N, J+KB ) 1191 BB( 1+I-J, J ) = B( I, J ) 1192 420 CONTINUE 1193 430 CONTINUE 1194 END IF 1195* 1196 CALL ZHBGVD( 'V', UPLO, N, KA, KB, AB, LDA, BB, 1197 $ LDB, D, Z, LDZ, WORK, NWORK, RWORK, 1198 $ LRWORK, IWORK, LIWORK, IINFO ) 1199 IF( IINFO.NE.0 ) THEN 1200 WRITE( NOUNIT, FMT = 9999 )'ZHBGVD(V,' // 1201 $ UPLO // ')', IINFO, N, JTYPE, IOLDSD 1202 INFO = ABS( IINFO ) 1203 IF( IINFO.LT.0 ) THEN 1204 RETURN 1205 ELSE 1206 RESULT( NTEST ) = ULPINV 1207 GO TO 620 1208 END IF 1209 END IF 1210* 1211* Do Test 1212* 1213 CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z, 1214 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) ) 1215* 1216* Test ZHBGVX 1217* 1218 NTEST = NTEST + 1 1219* 1220* Copy the matrices into band storage. 1221* 1222 IF( LSAME( UPLO, 'U' ) ) THEN 1223 DO 460 J = 1, N 1224 DO 440 I = MAX( 1, J-KA ), J 1225 AB( KA+1+I-J, J ) = A( I, J ) 1226 440 CONTINUE 1227 DO 450 I = MAX( 1, J-KB ), J 1228 BB( KB+1+I-J, J ) = B( I, J ) 1229 450 CONTINUE 1230 460 CONTINUE 1231 ELSE 1232 DO 490 J = 1, N 1233 DO 470 I = J, MIN( N, J+KA ) 1234 AB( 1+I-J, J ) = A( I, J ) 1235 470 CONTINUE 1236 DO 480 I = J, MIN( N, J+KB ) 1237 BB( 1+I-J, J ) = B( I, J ) 1238 480 CONTINUE 1239 490 CONTINUE 1240 END IF 1241* 1242 CALL ZHBGVX( 'V', 'A', UPLO, N, KA, KB, AB, LDA, 1243 $ BB, LDB, BP, MAX( 1, N ), VL, VU, IL, 1244 $ IU, ABSTOL, M, D, Z, LDZ, WORK, RWORK, 1245 $ IWORK( N+1 ), IWORK, IINFO ) 1246 IF( IINFO.NE.0 ) THEN 1247 WRITE( NOUNIT, FMT = 9999 )'ZHBGVX(V,A' // 1248 $ UPLO // ')', IINFO, N, JTYPE, IOLDSD 1249 INFO = ABS( IINFO ) 1250 IF( IINFO.LT.0 ) THEN 1251 RETURN 1252 ELSE 1253 RESULT( NTEST ) = ULPINV 1254 GO TO 620 1255 END IF 1256 END IF 1257* 1258* Do Test 1259* 1260 CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z, 1261 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) ) 1262* 1263 NTEST = NTEST + 1 1264* 1265* Copy the matrices into band storage. 1266* 1267 IF( LSAME( UPLO, 'U' ) ) THEN 1268 DO 520 J = 1, N 1269 DO 500 I = MAX( 1, J-KA ), J 1270 AB( KA+1+I-J, J ) = A( I, J ) 1271 500 CONTINUE 1272 DO 510 I = MAX( 1, J-KB ), J 1273 BB( KB+1+I-J, J ) = B( I, J ) 1274 510 CONTINUE 1275 520 CONTINUE 1276 ELSE 1277 DO 550 J = 1, N 1278 DO 530 I = J, MIN( N, J+KA ) 1279 AB( 1+I-J, J ) = A( I, J ) 1280 530 CONTINUE 1281 DO 540 I = J, MIN( N, J+KB ) 1282 BB( 1+I-J, J ) = B( I, J ) 1283 540 CONTINUE 1284 550 CONTINUE 1285 END IF 1286* 1287 VL = ZERO 1288 VU = ANORM 1289 CALL ZHBGVX( 'V', 'V', UPLO, N, KA, KB, AB, LDA, 1290 $ BB, LDB, BP, MAX( 1, N ), VL, VU, IL, 1291 $ IU, ABSTOL, M, D, Z, LDZ, WORK, RWORK, 1292 $ IWORK( N+1 ), IWORK, IINFO ) 1293 IF( IINFO.NE.0 ) THEN 1294 WRITE( NOUNIT, FMT = 9999 )'ZHBGVX(V,V' // 1295 $ UPLO // ')', IINFO, N, JTYPE, IOLDSD 1296 INFO = ABS( IINFO ) 1297 IF( IINFO.LT.0 ) THEN 1298 RETURN 1299 ELSE 1300 RESULT( NTEST ) = ULPINV 1301 GO TO 620 1302 END IF 1303 END IF 1304* 1305* Do Test 1306* 1307 CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z, 1308 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) ) 1309* 1310 NTEST = NTEST + 1 1311* 1312* Copy the matrices into band storage. 1313* 1314 IF( LSAME( UPLO, 'U' ) ) THEN 1315 DO 580 J = 1, N 1316 DO 560 I = MAX( 1, J-KA ), J 1317 AB( KA+1+I-J, J ) = A( I, J ) 1318 560 CONTINUE 1319 DO 570 I = MAX( 1, J-KB ), J 1320 BB( KB+1+I-J, J ) = B( I, J ) 1321 570 CONTINUE 1322 580 CONTINUE 1323 ELSE 1324 DO 610 J = 1, N 1325 DO 590 I = J, MIN( N, J+KA ) 1326 AB( 1+I-J, J ) = A( I, J ) 1327 590 CONTINUE 1328 DO 600 I = J, MIN( N, J+KB ) 1329 BB( 1+I-J, J ) = B( I, J ) 1330 600 CONTINUE 1331 610 CONTINUE 1332 END IF 1333* 1334 CALL ZHBGVX( 'V', 'I', UPLO, N, KA, KB, AB, LDA, 1335 $ BB, LDB, BP, MAX( 1, N ), VL, VU, IL, 1336 $ IU, ABSTOL, M, D, Z, LDZ, WORK, RWORK, 1337 $ IWORK( N+1 ), IWORK, IINFO ) 1338 IF( IINFO.NE.0 ) THEN 1339 WRITE( NOUNIT, FMT = 9999 )'ZHBGVX(V,I' // 1340 $ UPLO // ')', IINFO, N, JTYPE, IOLDSD 1341 INFO = ABS( IINFO ) 1342 IF( IINFO.LT.0 ) THEN 1343 RETURN 1344 ELSE 1345 RESULT( NTEST ) = ULPINV 1346 GO TO 620 1347 END IF 1348 END IF 1349* 1350* Do Test 1351* 1352 CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z, 1353 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) ) 1354* 1355 END IF 1356* 1357 620 CONTINUE 1358 630 CONTINUE 1359* 1360* End of Loop -- Check for RESULT(j) > THRESH 1361* 1362 NTESTT = NTESTT + NTEST 1363 CALL DLAFTS( 'ZSG', N, N, JTYPE, NTEST, RESULT, IOLDSD, 1364 $ THRESH, NOUNIT, NERRS ) 1365 640 CONTINUE 1366 650 CONTINUE 1367* 1368* Summary 1369* 1370 CALL DLASUM( 'ZSG', NOUNIT, NERRS, NTESTT ) 1371* 1372 RETURN 1373* 1374 9999 FORMAT( ' ZDRVSG2STG: ', A, ' returned INFO=', I6, '.', / 9X, 1375 $ 'N=', I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' ) 1376* 1377* End of ZDRVSG2STG 1378* 1379 END 1380