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