1*> \brief \b DDRVSG 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 DDRVSG( 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* DOUBLE PRECISION THRESH 19* .. 20* .. Array Arguments .. 21* LOGICAL DOTYPE( * ) 22* INTEGER ISEED( 4 ), IWORK( * ), NN( * ) 23* DOUBLE PRECISION 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*> DDRVSG checks the real symmetric generalized eigenproblem 35*> drivers. 36*> 37*> DSYGV computes all eigenvalues and, optionally, 38*> eigenvectors of a real symmetric-definite generalized 39*> eigenproblem. 40*> 41*> DSYGVD computes all eigenvalues and, optionally, 42*> eigenvectors of a real symmetric-definite generalized 43*> eigenproblem using a divide and conquer algorithm. 44*> 45*> DSYGVX computes selected eigenvalues and, optionally, 46*> eigenvectors of a real symmetric-definite generalized 47*> eigenproblem. 48*> 49*> DSPGV computes all eigenvalues and, optionally, 50*> eigenvectors of a real symmetric-definite generalized 51*> eigenproblem in packed storage. 52*> 53*> DSPGVD 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*> DSPGVX computes selected eigenvalues and, optionally, 59*> eigenvectors of a real symmetric-definite generalized 60*> eigenproblem in packed storage. 61*> 62*> DSBGV computes all eigenvalues and, optionally, 63*> eigenvectors of a real symmetric-definite banded 64*> generalized eigenproblem. 65*> 66*> DSBGVD 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*> DSBGVX computes selected eigenvalues and, optionally, 72*> eigenvectors of a real symmetric-definite banded 73*> generalized eigenproblem. 74*> 75*> When DDRVSG 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) DSYGV with ITYPE = 1 and UPLO ='U': 84*> 85*> | A Z - B Z D | / ( |A| |Z| n ulp ) 86*> 87*> (2) as (1) but calling DSPGV 88*> (3) as (1) but calling DSBGV 89*> (4) as (1) but with UPLO = 'L' 90*> (5) as (4) but calling DSPGV 91*> (6) as (4) but calling DSBGV 92*> 93*> (7) DSYGV with ITYPE = 2 and UPLO ='U': 94*> 95*> | A B Z - Z D | / ( |A| |Z| n ulp ) 96*> 97*> (8) as (7) but calling DSPGV 98*> (9) as (7) but with UPLO = 'L' 99*> (10) as (9) but calling DSPGV 100*> 101*> (11) DSYGV with ITYPE = 3 and UPLO ='U': 102*> 103*> | B A Z - Z D | / ( |A| |Z| n ulp ) 104*> 105*> (12) as (11) but calling DSPGV 106*> (13) as (11) but with UPLO = 'L' 107*> (14) as (13) but calling DSPGV 108*> 109*> DSYGVD, DSPGVD and DSBGVD performed the same 14 tests. 110*> 111*> DSYGVX, DSPGVX and DSBGVX 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*> DDRVSG 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, DDRVSG 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 DDRVSG to continue the same random number 207*> sequence. 208*> Modified. 209*> 210*> THRESH DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION array, dimension (LDA, max(NN)) 262*> Workspace. 263*> Modified. 264*> 265*> BB DOUBLE PRECISION array, dimension (LDB, max(NN)) 266*> Workspace. 267*> Modified. 268*> 269*> AP DOUBLE PRECISION array, dimension (max(NN)**2) 270*> Workspace. 271*> Modified. 272*> 273*> BP DOUBLE PRECISION array, dimension (max(NN)**2) 274*> Workspace. 275*> Modified. 276*> 277*> WORK DOUBLE PRECISION 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 DOUBLE PRECISION 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 DLATMR, SLATMS, DSYGV, DSPGV, DSBGV, SSYGVD, SSPGVD, 310*> DSBGVD, DSYGVX, DSPGVX 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 DLAFTS). 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*> \date November 2011 350* 351*> \ingroup double_eig 352* 353* ===================================================================== 354 SUBROUTINE DDRVSG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, 355 $ NOUNIT, A, LDA, B, LDB, D, Z, LDZ, AB, BB, AP, 356 $ BP, WORK, NWORK, IWORK, LIWORK, RESULT, INFO ) 357* 358* -- LAPACK test routine (version 3.4.0) -- 359* -- LAPACK is a software package provided by Univ. of Tennessee, -- 360* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 361* November 2011 362* 363* .. Scalar Arguments .. 364 INTEGER INFO, LDA, LDB, LDZ, LIWORK, NOUNIT, NSIZES, 365 $ NTYPES, NWORK 366 DOUBLE PRECISION THRESH 367* .. 368* .. Array Arguments .. 369 LOGICAL DOTYPE( * ) 370 INTEGER ISEED( 4 ), IWORK( * ), NN( * ) 371 DOUBLE PRECISION A( LDA, * ), AB( LDA, * ), AP( * ), 372 $ B( LDB, * ), BB( LDB, * ), BP( * ), D( * ), 373 $ RESULT( * ), WORK( * ), Z( LDZ, * ) 374* .. 375* 376* ===================================================================== 377* 378* .. Parameters .. 379 DOUBLE PRECISION ZERO, ONE, TEN 380 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TEN = 10.0D0 ) 381 INTEGER MAXTYP 382 PARAMETER ( MAXTYP = 21 ) 383* .. 384* .. Local Scalars .. 385 LOGICAL BADNN 386 CHARACTER UPLO 387 INTEGER I, IBTYPE, IBUPLO, IINFO, IJ, IL, IMODE, ITEMP, 388 $ ITYPE, IU, J, JCOL, JSIZE, JTYPE, KA, KA9, KB, 389 $ KB9, M, MTYPES, N, NERRS, NMATS, NMAX, NTEST, 390 $ NTESTT 391 DOUBLE PRECISION ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL, 392 $ RTUNFL, ULP, ULPINV, UNFL, VL, VU 393* .. 394* .. Local Arrays .. 395 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ), 396 $ KMAGN( MAXTYP ), KMODE( MAXTYP ), 397 $ KTYPE( MAXTYP ) 398* .. 399* .. External Functions .. 400 LOGICAL LSAME 401 DOUBLE PRECISION DLAMCH, DLARND 402 EXTERNAL LSAME, DLAMCH, DLARND 403* .. 404* .. External Subroutines .. 405 EXTERNAL DLABAD, DLACPY, DLAFTS, DLASET, DLASUM, DLATMR, 406 $ DLATMS, DSBGV, DSBGVD, DSBGVX, DSGT01, DSPGV, 407 $ DSPGVD, DSPGVX, DSYGV, DSYGVD, DSYGVX, XERBLA 408* .. 409* .. Intrinsic Functions .. 410 INTRINSIC ABS, DBLE, MAX, MIN, SQRT 411* .. 412* .. Data statements .. 413 DATA KTYPE / 1, 2, 5*4, 5*5, 3*8, 6*9 / 414 DATA KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1, 415 $ 2, 3, 6*1 / 416 DATA KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0, 417 $ 0, 0, 6*4 / 418* .. 419* .. Executable Statements .. 420* 421* 1) Check for errors 422* 423 NTESTT = 0 424 INFO = 0 425* 426 BADNN = .FALSE. 427 NMAX = 0 428 DO 10 J = 1, NSIZES 429 NMAX = MAX( NMAX, NN( J ) ) 430 IF( NN( J ).LT.0 ) 431 $ BADNN = .TRUE. 432 10 CONTINUE 433* 434* Check for errors 435* 436 IF( NSIZES.LT.0 ) THEN 437 INFO = -1 438 ELSE IF( BADNN ) THEN 439 INFO = -2 440 ELSE IF( NTYPES.LT.0 ) THEN 441 INFO = -3 442 ELSE IF( LDA.LE.1 .OR. LDA.LT.NMAX ) THEN 443 INFO = -9 444 ELSE IF( LDZ.LE.1 .OR. LDZ.LT.NMAX ) THEN 445 INFO = -16 446 ELSE IF( 2*MAX( NMAX, 3 )**2.GT.NWORK ) THEN 447 INFO = -21 448 ELSE IF( 2*MAX( NMAX, 3 )**2.GT.LIWORK ) THEN 449 INFO = -23 450 END IF 451* 452 IF( INFO.NE.0 ) THEN 453 CALL XERBLA( 'DDRVSG', -INFO ) 454 RETURN 455 END IF 456* 457* Quick return if possible 458* 459 IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 ) 460 $ RETURN 461* 462* More Important constants 463* 464 UNFL = DLAMCH( 'Safe minimum' ) 465 OVFL = DLAMCH( 'Overflow' ) 466 CALL DLABAD( UNFL, OVFL ) 467 ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) 468 ULPINV = ONE / ULP 469 RTUNFL = SQRT( UNFL ) 470 RTOVFL = SQRT( OVFL ) 471* 472 DO 20 I = 1, 4 473 ISEED2( I ) = ISEED( I ) 474 20 CONTINUE 475* 476* Loop over sizes, types 477* 478 NERRS = 0 479 NMATS = 0 480* 481 DO 650 JSIZE = 1, NSIZES 482 N = NN( JSIZE ) 483 ANINV = ONE / DBLE( MAX( 1, N ) ) 484* 485 IF( NSIZES.NE.1 ) THEN 486 MTYPES = MIN( MAXTYP, NTYPES ) 487 ELSE 488 MTYPES = MIN( MAXTYP+1, NTYPES ) 489 END IF 490* 491 KA9 = 0 492 KB9 = 0 493 DO 640 JTYPE = 1, MTYPES 494 IF( .NOT.DOTYPE( JTYPE ) ) 495 $ GO TO 640 496 NMATS = NMATS + 1 497 NTEST = 0 498* 499 DO 30 J = 1, 4 500 IOLDSD( J ) = ISEED( J ) 501 30 CONTINUE 502* 503* 2) Compute "A" 504* 505* Control parameters: 506* 507* KMAGN KMODE KTYPE 508* =1 O(1) clustered 1 zero 509* =2 large clustered 2 identity 510* =3 small exponential (none) 511* =4 arithmetic diagonal, w/ eigenvalues 512* =5 random log hermitian, w/ eigenvalues 513* =6 random (none) 514* =7 random diagonal 515* =8 random hermitian 516* =9 banded, w/ eigenvalues 517* 518 IF( MTYPES.GT.MAXTYP ) 519 $ GO TO 90 520* 521 ITYPE = KTYPE( JTYPE ) 522 IMODE = KMODE( JTYPE ) 523* 524* Compute norm 525* 526 GO TO ( 40, 50, 60 )KMAGN( JTYPE ) 527* 528 40 CONTINUE 529 ANORM = ONE 530 GO TO 70 531* 532 50 CONTINUE 533 ANORM = ( RTOVFL*ULP )*ANINV 534 GO TO 70 535* 536 60 CONTINUE 537 ANORM = RTUNFL*N*ULPINV 538 GO TO 70 539* 540 70 CONTINUE 541* 542 IINFO = 0 543 COND = ULPINV 544* 545* Special Matrices -- Identity & Jordan block 546* 547 IF( ITYPE.EQ.1 ) THEN 548* 549* Zero 550* 551 KA = 0 552 KB = 0 553 CALL DLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA ) 554* 555 ELSE IF( ITYPE.EQ.2 ) THEN 556* 557* Identity 558* 559 KA = 0 560 KB = 0 561 CALL DLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA ) 562 DO 80 JCOL = 1, N 563 A( JCOL, JCOL ) = ANORM 564 80 CONTINUE 565* 566 ELSE IF( ITYPE.EQ.4 ) THEN 567* 568* Diagonal Matrix, [Eigen]values Specified 569* 570 KA = 0 571 KB = 0 572 CALL DLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND, 573 $ ANORM, 0, 0, 'N', A, LDA, WORK( N+1 ), 574 $ IINFO ) 575* 576 ELSE IF( ITYPE.EQ.5 ) THEN 577* 578* symmetric, eigenvalues specified 579* 580 KA = MAX( 0, N-1 ) 581 KB = KA 582 CALL DLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND, 583 $ ANORM, N, N, 'N', A, LDA, WORK( N+1 ), 584 $ IINFO ) 585* 586 ELSE IF( ITYPE.EQ.7 ) THEN 587* 588* Diagonal, random eigenvalues 589* 590 KA = 0 591 KB = 0 592 CALL DLATMR( N, N, 'S', ISEED, 'S', WORK, 6, ONE, ONE, 593 $ 'T', 'N', WORK( N+1 ), 1, ONE, 594 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0, 595 $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO ) 596* 597 ELSE IF( ITYPE.EQ.8 ) THEN 598* 599* symmetric, random eigenvalues 600* 601 KA = MAX( 0, N-1 ) 602 KB = KA 603 CALL DLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, ONE, 604 $ 'T', 'N', WORK( N+1 ), 1, ONE, 605 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N, 606 $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO ) 607* 608 ELSE IF( ITYPE.EQ.9 ) THEN 609* 610* symmetric banded, eigenvalues specified 611* 612* The following values are used for the half-bandwidths: 613* 614* ka = 1 kb = 1 615* ka = 2 kb = 1 616* ka = 2 kb = 2 617* ka = 3 kb = 1 618* ka = 3 kb = 2 619* ka = 3 kb = 3 620* 621 KB9 = KB9 + 1 622 IF( KB9.GT.KA9 ) THEN 623 KA9 = KA9 + 1 624 KB9 = 1 625 END IF 626 KA = MAX( 0, MIN( N-1, KA9 ) ) 627 KB = MAX( 0, MIN( N-1, KB9 ) ) 628 CALL DLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND, 629 $ ANORM, KA, KA, 'N', A, LDA, WORK( N+1 ), 630 $ IINFO ) 631* 632 ELSE 633* 634 IINFO = 1 635 END IF 636* 637 IF( IINFO.NE.0 ) THEN 638 WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE, 639 $ IOLDSD 640 INFO = ABS( IINFO ) 641 RETURN 642 END IF 643* 644 90 CONTINUE 645* 646 ABSTOL = UNFL + UNFL 647 IF( N.LE.1 ) THEN 648 IL = 1 649 IU = N 650 ELSE 651 IL = 1 + ( N-1 )*DLARND( 1, ISEED2 ) 652 IU = 1 + ( N-1 )*DLARND( 1, ISEED2 ) 653 IF( IL.GT.IU ) THEN 654 ITEMP = IL 655 IL = IU 656 IU = ITEMP 657 END IF 658 END IF 659* 660* 3) Call DSYGV, DSPGV, DSBGV, SSYGVD, SSPGVD, SSBGVD, 661* DSYGVX, DSPGVX, and DSBGVX, do tests. 662* 663* loop over the three generalized problems 664* IBTYPE = 1: A*x = (lambda)*B*x 665* IBTYPE = 2: A*B*x = (lambda)*x 666* IBTYPE = 3: B*A*x = (lambda)*x 667* 668 DO 630 IBTYPE = 1, 3 669* 670* loop over the setting UPLO 671* 672 DO 620 IBUPLO = 1, 2 673 IF( IBUPLO.EQ.1 ) 674 $ UPLO = 'U' 675 IF( IBUPLO.EQ.2 ) 676 $ UPLO = 'L' 677* 678* Generate random well-conditioned positive definite 679* matrix B, of bandwidth not greater than that of A. 680* 681 CALL DLATMS( N, N, 'U', ISEED, 'P', WORK, 5, TEN, ONE, 682 $ KB, KB, UPLO, B, LDB, WORK( N+1 ), 683 $ IINFO ) 684* 685* Test DSYGV 686* 687 NTEST = NTEST + 1 688* 689 CALL DLACPY( ' ', N, N, A, LDA, Z, LDZ ) 690 CALL DLACPY( UPLO, N, N, B, LDB, BB, LDB ) 691* 692 CALL DSYGV( IBTYPE, 'V', UPLO, N, Z, LDZ, BB, LDB, D, 693 $ WORK, NWORK, IINFO ) 694 IF( IINFO.NE.0 ) THEN 695 WRITE( NOUNIT, FMT = 9999 )'DSYGV(V,' // UPLO // 696 $ ')', IINFO, N, JTYPE, IOLDSD 697 INFO = ABS( IINFO ) 698 IF( IINFO.LT.0 ) THEN 699 RETURN 700 ELSE 701 RESULT( NTEST ) = ULPINV 702 GO TO 100 703 END IF 704 END IF 705* 706* Do Test 707* 708 CALL DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z, 709 $ LDZ, D, WORK, RESULT( NTEST ) ) 710* 711* Test DSYGVD 712* 713 NTEST = NTEST + 1 714* 715 CALL DLACPY( ' ', N, N, A, LDA, Z, LDZ ) 716 CALL DLACPY( UPLO, N, N, B, LDB, BB, LDB ) 717* 718 CALL DSYGVD( IBTYPE, 'V', UPLO, N, Z, LDZ, BB, LDB, D, 719 $ WORK, NWORK, IWORK, LIWORK, IINFO ) 720 IF( IINFO.NE.0 ) THEN 721 WRITE( NOUNIT, FMT = 9999 )'DSYGVD(V,' // UPLO // 722 $ ')', IINFO, N, JTYPE, IOLDSD 723 INFO = ABS( IINFO ) 724 IF( IINFO.LT.0 ) THEN 725 RETURN 726 ELSE 727 RESULT( NTEST ) = ULPINV 728 GO TO 100 729 END IF 730 END IF 731* 732* Do Test 733* 734 CALL DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z, 735 $ LDZ, D, WORK, RESULT( NTEST ) ) 736* 737* Test DSYGVX 738* 739 NTEST = NTEST + 1 740* 741 CALL DLACPY( ' ', N, N, A, LDA, AB, LDA ) 742 CALL DLACPY( UPLO, N, N, B, LDB, BB, LDB ) 743* 744 CALL DSYGVX( IBTYPE, 'V', 'A', UPLO, N, AB, LDA, BB, 745 $ LDB, VL, VU, IL, IU, ABSTOL, M, D, Z, 746 $ LDZ, WORK, NWORK, IWORK( N+1 ), IWORK, 747 $ IINFO ) 748 IF( IINFO.NE.0 ) THEN 749 WRITE( NOUNIT, FMT = 9999 )'DSYGVX(V,A' // UPLO // 750 $ ')', IINFO, N, JTYPE, IOLDSD 751 INFO = ABS( IINFO ) 752 IF( IINFO.LT.0 ) THEN 753 RETURN 754 ELSE 755 RESULT( NTEST ) = ULPINV 756 GO TO 100 757 END IF 758 END IF 759* 760* Do Test 761* 762 CALL DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z, 763 $ LDZ, D, WORK, RESULT( NTEST ) ) 764* 765 NTEST = NTEST + 1 766* 767 CALL DLACPY( ' ', N, N, A, LDA, AB, LDA ) 768 CALL DLACPY( UPLO, N, N, B, LDB, BB, LDB ) 769* 770* since we do not know the exact eigenvalues of this 771* eigenpair, we just set VL and VU as constants. 772* It is quite possible that there are no eigenvalues 773* in this interval. 774* 775 VL = ZERO 776 VU = ANORM 777 CALL DSYGVX( IBTYPE, 'V', 'V', UPLO, N, AB, LDA, BB, 778 $ LDB, VL, VU, IL, IU, ABSTOL, M, D, Z, 779 $ LDZ, WORK, NWORK, IWORK( N+1 ), IWORK, 780 $ IINFO ) 781 IF( IINFO.NE.0 ) THEN 782 WRITE( NOUNIT, FMT = 9999 )'DSYGVX(V,V,' // 783 $ UPLO // ')', IINFO, N, JTYPE, IOLDSD 784 INFO = ABS( IINFO ) 785 IF( IINFO.LT.0 ) THEN 786 RETURN 787 ELSE 788 RESULT( NTEST ) = ULPINV 789 GO TO 100 790 END IF 791 END IF 792* 793* Do Test 794* 795 CALL DSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z, 796 $ LDZ, D, WORK, RESULT( NTEST ) ) 797* 798 NTEST = NTEST + 1 799* 800 CALL DLACPY( ' ', N, N, A, LDA, AB, LDA ) 801 CALL DLACPY( UPLO, N, N, B, LDB, BB, LDB ) 802* 803 CALL DSYGVX( IBTYPE, 'V', 'I', UPLO, N, AB, LDA, BB, 804 $ LDB, VL, VU, IL, IU, ABSTOL, M, D, Z, 805 $ LDZ, WORK, NWORK, IWORK( N+1 ), IWORK, 806 $ IINFO ) 807 IF( IINFO.NE.0 ) THEN 808 WRITE( NOUNIT, FMT = 9999 )'DSYGVX(V,I,' // 809 $ UPLO // ')', IINFO, N, JTYPE, IOLDSD 810 INFO = ABS( IINFO ) 811 IF( IINFO.LT.0 ) THEN 812 RETURN 813 ELSE 814 RESULT( NTEST ) = ULPINV 815 GO TO 100 816 END IF 817 END IF 818* 819* Do Test 820* 821 CALL DSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z, 822 $ LDZ, D, WORK, RESULT( NTEST ) ) 823* 824 100 CONTINUE 825* 826* Test DSPGV 827* 828 NTEST = NTEST + 1 829* 830* Copy the matrices into packed storage. 831* 832 IF( LSAME( UPLO, 'U' ) ) THEN 833 IJ = 1 834 DO 120 J = 1, N 835 DO 110 I = 1, J 836 AP( IJ ) = A( I, J ) 837 BP( IJ ) = B( I, J ) 838 IJ = IJ + 1 839 110 CONTINUE 840 120 CONTINUE 841 ELSE 842 IJ = 1 843 DO 140 J = 1, N 844 DO 130 I = J, N 845 AP( IJ ) = A( I, J ) 846 BP( IJ ) = B( I, J ) 847 IJ = IJ + 1 848 130 CONTINUE 849 140 CONTINUE 850 END IF 851* 852 CALL DSPGV( IBTYPE, 'V', UPLO, N, AP, BP, D, Z, LDZ, 853 $ WORK, IINFO ) 854 IF( IINFO.NE.0 ) THEN 855 WRITE( NOUNIT, FMT = 9999 )'DSPGV(V,' // UPLO // 856 $ ')', IINFO, N, JTYPE, IOLDSD 857 INFO = ABS( IINFO ) 858 IF( IINFO.LT.0 ) THEN 859 RETURN 860 ELSE 861 RESULT( NTEST ) = ULPINV 862 GO TO 310 863 END IF 864 END IF 865* 866* Do Test 867* 868 CALL DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z, 869 $ LDZ, D, WORK, RESULT( NTEST ) ) 870* 871* Test DSPGVD 872* 873 NTEST = NTEST + 1 874* 875* Copy the matrices into packed storage. 876* 877 IF( LSAME( UPLO, 'U' ) ) THEN 878 IJ = 1 879 DO 160 J = 1, N 880 DO 150 I = 1, J 881 AP( IJ ) = A( I, J ) 882 BP( IJ ) = B( I, J ) 883 IJ = IJ + 1 884 150 CONTINUE 885 160 CONTINUE 886 ELSE 887 IJ = 1 888 DO 180 J = 1, N 889 DO 170 I = J, N 890 AP( IJ ) = A( I, J ) 891 BP( IJ ) = B( I, J ) 892 IJ = IJ + 1 893 170 CONTINUE 894 180 CONTINUE 895 END IF 896* 897 CALL DSPGVD( IBTYPE, 'V', UPLO, N, AP, BP, D, Z, LDZ, 898 $ WORK, NWORK, IWORK, LIWORK, IINFO ) 899 IF( IINFO.NE.0 ) THEN 900 WRITE( NOUNIT, FMT = 9999 )'DSPGVD(V,' // UPLO // 901 $ ')', IINFO, N, JTYPE, IOLDSD 902 INFO = ABS( IINFO ) 903 IF( IINFO.LT.0 ) THEN 904 RETURN 905 ELSE 906 RESULT( NTEST ) = ULPINV 907 GO TO 310 908 END IF 909 END IF 910* 911* Do Test 912* 913 CALL DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z, 914 $ LDZ, D, WORK, RESULT( NTEST ) ) 915* 916* Test DSPGVX 917* 918 NTEST = NTEST + 1 919* 920* Copy the matrices into packed storage. 921* 922 IF( LSAME( UPLO, 'U' ) ) THEN 923 IJ = 1 924 DO 200 J = 1, N 925 DO 190 I = 1, J 926 AP( IJ ) = A( I, J ) 927 BP( IJ ) = B( I, J ) 928 IJ = IJ + 1 929 190 CONTINUE 930 200 CONTINUE 931 ELSE 932 IJ = 1 933 DO 220 J = 1, N 934 DO 210 I = J, N 935 AP( IJ ) = A( I, J ) 936 BP( IJ ) = B( I, J ) 937 IJ = IJ + 1 938 210 CONTINUE 939 220 CONTINUE 940 END IF 941* 942 CALL DSPGVX( IBTYPE, 'V', 'A', UPLO, N, AP, BP, VL, 943 $ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK, 944 $ IWORK( N+1 ), IWORK, INFO ) 945 IF( IINFO.NE.0 ) THEN 946 WRITE( NOUNIT, FMT = 9999 )'DSPGVX(V,A' // UPLO // 947 $ ')', IINFO, N, JTYPE, IOLDSD 948 INFO = ABS( IINFO ) 949 IF( IINFO.LT.0 ) THEN 950 RETURN 951 ELSE 952 RESULT( NTEST ) = ULPINV 953 GO TO 310 954 END IF 955 END IF 956* 957* Do Test 958* 959 CALL DSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z, 960 $ LDZ, D, WORK, RESULT( NTEST ) ) 961* 962 NTEST = NTEST + 1 963* 964* Copy the matrices into packed storage. 965* 966 IF( LSAME( UPLO, 'U' ) ) THEN 967 IJ = 1 968 DO 240 J = 1, N 969 DO 230 I = 1, J 970 AP( IJ ) = A( I, J ) 971 BP( IJ ) = B( I, J ) 972 IJ = IJ + 1 973 230 CONTINUE 974 240 CONTINUE 975 ELSE 976 IJ = 1 977 DO 260 J = 1, N 978 DO 250 I = J, N 979 AP( IJ ) = A( I, J ) 980 BP( IJ ) = B( I, J ) 981 IJ = IJ + 1 982 250 CONTINUE 983 260 CONTINUE 984 END IF 985* 986 VL = ZERO 987 VU = ANORM 988 CALL DSPGVX( IBTYPE, 'V', 'V', UPLO, N, AP, BP, VL, 989 $ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK, 990 $ IWORK( N+1 ), IWORK, INFO ) 991 IF( IINFO.NE.0 ) THEN 992 WRITE( NOUNIT, FMT = 9999 )'DSPGVX(V,V' // UPLO // 993 $ ')', IINFO, N, JTYPE, IOLDSD 994 INFO = ABS( IINFO ) 995 IF( IINFO.LT.0 ) THEN 996 RETURN 997 ELSE 998 RESULT( NTEST ) = ULPINV 999 GO TO 310 1000 END IF 1001 END IF 1002* 1003* Do Test 1004* 1005 CALL DSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z, 1006 $ LDZ, D, WORK, RESULT( NTEST ) ) 1007* 1008 NTEST = NTEST + 1 1009* 1010* Copy the matrices into packed storage. 1011* 1012 IF( LSAME( UPLO, 'U' ) ) THEN 1013 IJ = 1 1014 DO 280 J = 1, N 1015 DO 270 I = 1, J 1016 AP( IJ ) = A( I, J ) 1017 BP( IJ ) = B( I, J ) 1018 IJ = IJ + 1 1019 270 CONTINUE 1020 280 CONTINUE 1021 ELSE 1022 IJ = 1 1023 DO 300 J = 1, N 1024 DO 290 I = J, N 1025 AP( IJ ) = A( I, J ) 1026 BP( IJ ) = B( I, J ) 1027 IJ = IJ + 1 1028 290 CONTINUE 1029 300 CONTINUE 1030 END IF 1031* 1032 CALL DSPGVX( IBTYPE, 'V', 'I', UPLO, N, AP, BP, VL, 1033 $ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK, 1034 $ IWORK( N+1 ), IWORK, INFO ) 1035 IF( IINFO.NE.0 ) THEN 1036 WRITE( NOUNIT, FMT = 9999 )'DSPGVX(V,I' // UPLO // 1037 $ ')', IINFO, N, JTYPE, IOLDSD 1038 INFO = ABS( IINFO ) 1039 IF( IINFO.LT.0 ) THEN 1040 RETURN 1041 ELSE 1042 RESULT( NTEST ) = ULPINV 1043 GO TO 310 1044 END IF 1045 END IF 1046* 1047* Do Test 1048* 1049 CALL DSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z, 1050 $ LDZ, D, WORK, RESULT( NTEST ) ) 1051* 1052 310 CONTINUE 1053* 1054 IF( IBTYPE.EQ.1 ) THEN 1055* 1056* TEST DSBGV 1057* 1058 NTEST = NTEST + 1 1059* 1060* Copy the matrices into band storage. 1061* 1062 IF( LSAME( UPLO, 'U' ) ) THEN 1063 DO 340 J = 1, N 1064 DO 320 I = MAX( 1, J-KA ), J 1065 AB( KA+1+I-J, J ) = A( I, J ) 1066 320 CONTINUE 1067 DO 330 I = MAX( 1, J-KB ), J 1068 BB( KB+1+I-J, J ) = B( I, J ) 1069 330 CONTINUE 1070 340 CONTINUE 1071 ELSE 1072 DO 370 J = 1, N 1073 DO 350 I = J, MIN( N, J+KA ) 1074 AB( 1+I-J, J ) = A( I, J ) 1075 350 CONTINUE 1076 DO 360 I = J, MIN( N, J+KB ) 1077 BB( 1+I-J, J ) = B( I, J ) 1078 360 CONTINUE 1079 370 CONTINUE 1080 END IF 1081* 1082 CALL DSBGV( 'V', UPLO, N, KA, KB, AB, LDA, BB, LDB, 1083 $ D, Z, LDZ, WORK, IINFO ) 1084 IF( IINFO.NE.0 ) THEN 1085 WRITE( NOUNIT, FMT = 9999 )'DSBGV(V,' // 1086 $ UPLO // ')', IINFO, N, JTYPE, IOLDSD 1087 INFO = ABS( IINFO ) 1088 IF( IINFO.LT.0 ) THEN 1089 RETURN 1090 ELSE 1091 RESULT( NTEST ) = ULPINV 1092 GO TO 620 1093 END IF 1094 END IF 1095* 1096* Do Test 1097* 1098 CALL DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z, 1099 $ LDZ, D, WORK, RESULT( NTEST ) ) 1100* 1101* TEST DSBGVD 1102* 1103 NTEST = NTEST + 1 1104* 1105* Copy the matrices into band storage. 1106* 1107 IF( LSAME( UPLO, 'U' ) ) THEN 1108 DO 400 J = 1, N 1109 DO 380 I = MAX( 1, J-KA ), J 1110 AB( KA+1+I-J, J ) = A( I, J ) 1111 380 CONTINUE 1112 DO 390 I = MAX( 1, J-KB ), J 1113 BB( KB+1+I-J, J ) = B( I, J ) 1114 390 CONTINUE 1115 400 CONTINUE 1116 ELSE 1117 DO 430 J = 1, N 1118 DO 410 I = J, MIN( N, J+KA ) 1119 AB( 1+I-J, J ) = A( I, J ) 1120 410 CONTINUE 1121 DO 420 I = J, MIN( N, J+KB ) 1122 BB( 1+I-J, J ) = B( I, J ) 1123 420 CONTINUE 1124 430 CONTINUE 1125 END IF 1126* 1127 CALL DSBGVD( 'V', UPLO, N, KA, KB, AB, LDA, BB, 1128 $ LDB, D, Z, LDZ, WORK, NWORK, IWORK, 1129 $ LIWORK, IINFO ) 1130 IF( IINFO.NE.0 ) THEN 1131 WRITE( NOUNIT, FMT = 9999 )'DSBGVD(V,' // 1132 $ UPLO // ')', IINFO, N, JTYPE, IOLDSD 1133 INFO = ABS( IINFO ) 1134 IF( IINFO.LT.0 ) THEN 1135 RETURN 1136 ELSE 1137 RESULT( NTEST ) = ULPINV 1138 GO TO 620 1139 END IF 1140 END IF 1141* 1142* Do Test 1143* 1144 CALL DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z, 1145 $ LDZ, D, WORK, RESULT( NTEST ) ) 1146* 1147* Test DSBGVX 1148* 1149 NTEST = NTEST + 1 1150* 1151* Copy the matrices into band storage. 1152* 1153 IF( LSAME( UPLO, 'U' ) ) THEN 1154 DO 460 J = 1, N 1155 DO 440 I = MAX( 1, J-KA ), J 1156 AB( KA+1+I-J, J ) = A( I, J ) 1157 440 CONTINUE 1158 DO 450 I = MAX( 1, J-KB ), J 1159 BB( KB+1+I-J, J ) = B( I, J ) 1160 450 CONTINUE 1161 460 CONTINUE 1162 ELSE 1163 DO 490 J = 1, N 1164 DO 470 I = J, MIN( N, J+KA ) 1165 AB( 1+I-J, J ) = A( I, J ) 1166 470 CONTINUE 1167 DO 480 I = J, MIN( N, J+KB ) 1168 BB( 1+I-J, J ) = B( I, J ) 1169 480 CONTINUE 1170 490 CONTINUE 1171 END IF 1172* 1173 CALL DSBGVX( 'V', 'A', UPLO, N, KA, KB, AB, LDA, 1174 $ BB, LDB, BP, MAX( 1, N ), VL, VU, IL, 1175 $ IU, ABSTOL, M, D, Z, LDZ, WORK, 1176 $ IWORK( N+1 ), IWORK, IINFO ) 1177 IF( IINFO.NE.0 ) THEN 1178 WRITE( NOUNIT, FMT = 9999 )'DSBGVX(V,A' // 1179 $ UPLO // ')', IINFO, N, JTYPE, IOLDSD 1180 INFO = ABS( IINFO ) 1181 IF( IINFO.LT.0 ) THEN 1182 RETURN 1183 ELSE 1184 RESULT( NTEST ) = ULPINV 1185 GO TO 620 1186 END IF 1187 END IF 1188* 1189* Do Test 1190* 1191 CALL DSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z, 1192 $ LDZ, D, WORK, RESULT( NTEST ) ) 1193* 1194* 1195 NTEST = NTEST + 1 1196* 1197* Copy the matrices into band storage. 1198* 1199 IF( LSAME( UPLO, 'U' ) ) THEN 1200 DO 520 J = 1, N 1201 DO 500 I = MAX( 1, J-KA ), J 1202 AB( KA+1+I-J, J ) = A( I, J ) 1203 500 CONTINUE 1204 DO 510 I = MAX( 1, J-KB ), J 1205 BB( KB+1+I-J, J ) = B( I, J ) 1206 510 CONTINUE 1207 520 CONTINUE 1208 ELSE 1209 DO 550 J = 1, N 1210 DO 530 I = J, MIN( N, J+KA ) 1211 AB( 1+I-J, J ) = A( I, J ) 1212 530 CONTINUE 1213 DO 540 I = J, MIN( N, J+KB ) 1214 BB( 1+I-J, J ) = B( I, J ) 1215 540 CONTINUE 1216 550 CONTINUE 1217 END IF 1218* 1219 VL = ZERO 1220 VU = ANORM 1221 CALL DSBGVX( 'V', 'V', UPLO, N, KA, KB, AB, LDA, 1222 $ BB, LDB, BP, MAX( 1, N ), VL, VU, IL, 1223 $ IU, ABSTOL, M, D, Z, LDZ, WORK, 1224 $ IWORK( N+1 ), IWORK, IINFO ) 1225 IF( IINFO.NE.0 ) THEN 1226 WRITE( NOUNIT, FMT = 9999 )'DSBGVX(V,V' // 1227 $ UPLO // ')', IINFO, N, JTYPE, IOLDSD 1228 INFO = ABS( IINFO ) 1229 IF( IINFO.LT.0 ) THEN 1230 RETURN 1231 ELSE 1232 RESULT( NTEST ) = ULPINV 1233 GO TO 620 1234 END IF 1235 END IF 1236* 1237* Do Test 1238* 1239 CALL DSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z, 1240 $ LDZ, D, WORK, RESULT( NTEST ) ) 1241* 1242 NTEST = NTEST + 1 1243* 1244* Copy the matrices into band storage. 1245* 1246 IF( LSAME( UPLO, 'U' ) ) THEN 1247 DO 580 J = 1, N 1248 DO 560 I = MAX( 1, J-KA ), J 1249 AB( KA+1+I-J, J ) = A( I, J ) 1250 560 CONTINUE 1251 DO 570 I = MAX( 1, J-KB ), J 1252 BB( KB+1+I-J, J ) = B( I, J ) 1253 570 CONTINUE 1254 580 CONTINUE 1255 ELSE 1256 DO 610 J = 1, N 1257 DO 590 I = J, MIN( N, J+KA ) 1258 AB( 1+I-J, J ) = A( I, J ) 1259 590 CONTINUE 1260 DO 600 I = J, MIN( N, J+KB ) 1261 BB( 1+I-J, J ) = B( I, J ) 1262 600 CONTINUE 1263 610 CONTINUE 1264 END IF 1265* 1266 CALL DSBGVX( 'V', 'I', UPLO, N, KA, KB, AB, LDA, 1267 $ BB, LDB, BP, MAX( 1, N ), VL, VU, IL, 1268 $ IU, ABSTOL, M, D, Z, LDZ, WORK, 1269 $ IWORK( N+1 ), IWORK, IINFO ) 1270 IF( IINFO.NE.0 ) THEN 1271 WRITE( NOUNIT, FMT = 9999 )'DSBGVX(V,I' // 1272 $ UPLO // ')', IINFO, N, JTYPE, IOLDSD 1273 INFO = ABS( IINFO ) 1274 IF( IINFO.LT.0 ) THEN 1275 RETURN 1276 ELSE 1277 RESULT( NTEST ) = ULPINV 1278 GO TO 620 1279 END IF 1280 END IF 1281* 1282* Do Test 1283* 1284 CALL DSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z, 1285 $ LDZ, D, WORK, RESULT( NTEST ) ) 1286* 1287 END IF 1288* 1289 620 CONTINUE 1290 630 CONTINUE 1291* 1292* End of Loop -- Check for RESULT(j) > THRESH 1293* 1294 NTESTT = NTESTT + NTEST 1295 CALL DLAFTS( 'DSG', N, N, JTYPE, NTEST, RESULT, IOLDSD, 1296 $ THRESH, NOUNIT, NERRS ) 1297 640 CONTINUE 1298 650 CONTINUE 1299* 1300* Summary 1301* 1302 CALL DLASUM( 'DSG', NOUNIT, NERRS, NTESTT ) 1303* 1304 RETURN 1305* 1306* End of DDRVSG 1307* 1308 9999 FORMAT( ' DDRVSG: ', A, ' returned INFO=', I6, '.', / 9X, 'N=', 1309 $ I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' ) 1310 END 1311