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