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