TESTING/EIG/sdrvsg.f

   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 *> \date November 2011
 350 *
 351 *> \ingroup single_eig
 352 *
 353 *  =====================================================================
 354       SUBROUTINE SDRVSG( 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       REAL               THRESH
 367 *     ..
 368 *     .. Array Arguments ..
 369       LOGICAL            DOTYPE( * )
 370       INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
 371       REAL               A( LDA, * ), AB( LDA, * ), AP( * ),
 372      $                   B( LDB, * ), BB( LDB, * ), BP( * ), D( * ),
 373      $                   RESULT( * ), WORK( * ), Z( LDZ, * )
 374 *     ..
 375 *
 376 *  =====================================================================
 377 *
 378 *     .. Parameters ..
 379       REAL               ZERO, ONE, TEN
 380       PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0, TEN = 10.0E0 )
 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       REAL               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       REAL               SLAMCH, SLARND
 402       EXTERNAL           LSAME, SLAMCH, SLARND
 403 *     ..
 404 *     .. External Subroutines ..
 405       EXTERNAL           SLABAD, SLACPY, SLAFTS, SLASET, SLASUM, SLATMR,
 406      $                   SLATMS, SSBGV, SSBGVD, SSBGVX, SSGT01, SSPGV,
 407      $                   SSPGVD, SSPGVX, SSYGV, SSYGVD, SSYGVX, XERBLA
 408 *     ..
 409 *     .. Intrinsic Functions ..
 410       INTRINSIC          ABS, MAX, MIN, REAL, 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( 'SDRVSG', -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 = SLAMCH( 'Safe minimum' )
 465       OVFL = SLAMCH( 'Overflow' )
 466       CALL SLABAD( UNFL, OVFL )
 467       ULP = SLAMCH( 'Epsilon' )*SLAMCH( '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 / REAL( 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 SLASET( '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 SLASET( '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 SLATMS( 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 SLATMS( 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 SLATMR( 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 SLATMR( 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 SLATMS( 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 )*SLARND( 1, ISEED2 )
 652                IU = 1 + ( N-1 )*SLARND( 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 SSYGV, SSPGV, SSBGV, SSYGVD, SSPGVD, SSBGVD,
 661 *              SSYGVX, SSPGVX, and SSBGVX, 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 SLATMS( N, N, 'U', ISEED, 'P', WORK, 5, TEN, ONE,
 682      $                         KB, KB, UPLO, B, LDB, WORK( N+1 ),
 683      $                         IINFO )
 684 *
 685 *                 Test SSYGV
 686 *
 687                   NTEST = NTEST + 1
 688 *
 689                   CALL SLACPY( ' ', N, N, A, LDA, Z, LDZ )
 690                   CALL SLACPY( UPLO, N, N, B, LDB, BB, LDB )
 691 *
 692                   CALL SSYGV( IBTYPE, 'V', UPLO, N, Z, LDZ, BB, LDB, D,
 693      $                        WORK, NWORK, IINFO )
 694                   IF( IINFO.NE.0 ) THEN
 695                      WRITE( NOUNIT, FMT = 9999 )'SSYGV(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 SSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
 709      $                         LDZ, D, WORK, RESULT( NTEST ) )
 710 *
 711 *                 Test SSYGVD
 712 *
 713                   NTEST = NTEST + 1
 714 *
 715                   CALL SLACPY( ' ', N, N, A, LDA, Z, LDZ )
 716                   CALL SLACPY( UPLO, N, N, B, LDB, BB, LDB )
 717 *
 718                   CALL SSYGVD( 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 )'SSYGVD(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 SSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
 735      $                         LDZ, D, WORK, RESULT( NTEST ) )
 736 *
 737 *                 Test SSYGVX
 738 *
 739                   NTEST = NTEST + 1
 740 *
 741                   CALL SLACPY( ' ', N, N, A, LDA, AB, LDA )
 742                   CALL SLACPY( UPLO, N, N, B, LDB, BB, LDB )
 743 *
 744                   CALL SSYGVX( 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 )'SSYGVX(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 SSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
 763      $                         LDZ, D, WORK, RESULT( NTEST ) )
 764 *
 765                   NTEST = NTEST + 1
 766 *
 767                   CALL SLACPY( ' ', N, N, A, LDA, AB, LDA )
 768                   CALL SLACPY( 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 SSYGVX( 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 )'SSYGVX(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 SSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
 796      $                         LDZ, D, WORK, RESULT( NTEST ) )
 797 *
 798                   NTEST = NTEST + 1
 799 *
 800                   CALL SLACPY( ' ', N, N, A, LDA, AB, LDA )
 801                   CALL SLACPY( UPLO, N, N, B, LDB, BB, LDB )
 802 *
 803                   CALL SSYGVX( 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 )'SSYGVX(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 SSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
 822      $                         LDZ, D, WORK, RESULT( NTEST ) )
 823 *
 824   100             CONTINUE
 825 *
 826 *                 Test SSPGV
 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 SSPGV( IBTYPE, 'V', UPLO, N, AP, BP, D, Z, LDZ,
 853      $                        WORK, IINFO )
 854                   IF( IINFO.NE.0 ) THEN
 855                      WRITE( NOUNIT, FMT = 9999 )'SSPGV(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 SSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
 869      $                         LDZ, D, WORK, RESULT( NTEST ) )
 870 *
 871 *                 Test SSPGVD
 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 SSPGVD( 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 )'SSPGVD(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 SSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
 914      $                         LDZ, D, WORK, RESULT( NTEST ) )
 915 *
 916 *                 Test SSPGVX
 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 SSPGVX( 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 )'SSPGVX(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 SSGT01( 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 SSPGVX( 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 )'SSPGVX(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 SSGT01( 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 SSPGVX( 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 )'SSPGVX(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 SSGT01( 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 SSBGV
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 SSBGV( '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 )'SSBGV(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 SSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
1099      $                            LDZ, D, WORK, RESULT( NTEST ) )
1100 *
1101 *                    TEST SSBGVD
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 SSBGVD( '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 )'SSBGVD(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 SSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
1145      $                            LDZ, D, WORK, RESULT( NTEST ) )
1146 *
1147 *                    Test SSBGVX
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 SSBGVX( '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 )'SSBGVX(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 SSGT01( 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 SSBGVX( '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 )'SSBGVX(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 SSGT01( 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 SSBGVX( '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 )'SSBGVX(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 SSGT01( 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 SLAFTS( 'SSG', N, N, JTYPE, NTEST, RESULT, IOLDSD,
1296      $                   THRESH, NOUNIT, NERRS )
1297   640    CONTINUE
1298   650 CONTINUE
1299 *
1300 *     Summary
1301 *
1302       CALL SLASUM( 'SSG', NOUNIT, NERRS, NTESTT )
1303 *
1304       RETURN
1305 *
1306 *     End of SDRVSG
1307 *
1308  9999 FORMAT( ' SDRVSG: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
1309      $      I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
1310       END