LAPACK: TESTING/EIG/ddrvsg.f Source File

Go to the documentation of this file.
00001       SUBROUTINE DDRVSG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
00002      $                   NOUNIT, A, LDA, B, LDB, D, Z, LDZ, AB, BB, AP,
00003      $                   BP, WORK, NWORK, IWORK, LIWORK, RESULT, INFO )
00004 *
00005 *  -- LAPACK test routine (version 3.1) --
00006 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00007 *     November 2006
00008 *
00009 *******************************************************************
00010 *
00011 *     modified August 1997, a new parameter LIWORK is added
00012 *     in the calling sequence.
00013 *
00014 *     test routine DDGT01 is also modified
00015 *
00016 *******************************************************************
00017 *
00018 *     .. Scalar Arguments ..
00019       INTEGER            INFO, LDA, LDB, LDZ, LIWORK, NOUNIT, NSIZES,
00020      $                   NTYPES, NWORK
00021       DOUBLE PRECISION   THRESH
00022 *     ..
00023 *     .. Array Arguments ..
00024       LOGICAL            DOTYPE( * )
00025       INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
00026       DOUBLE PRECISION   A( LDA, * ), AB( LDA, * ), AP( * ),
00027      $                   B( LDB, * ), BB( LDB, * ), BP( * ), D( * ),
00028      $                   RESULT( * ), WORK( * ), Z( LDZ, * )
00029 *     ..
00030 *
00031 *  Purpose
00032 *  =======
00033 *
00034 *       DDRVSG checks the real symmetric generalized eigenproblem
00035 *       drivers.
00036 *
00037 *               DSYGV computes all eigenvalues and, optionally,
00038 *               eigenvectors of a real symmetric-definite generalized
00039 *               eigenproblem.
00040 *
00041 *               DSYGVD computes all eigenvalues and, optionally,
00042 *               eigenvectors of a real symmetric-definite generalized
00043 *               eigenproblem using a divide and conquer algorithm.
00044 *
00045 *               DSYGVX computes selected eigenvalues and, optionally,
00046 *               eigenvectors of a real symmetric-definite generalized
00047 *               eigenproblem.
00048 *
00049 *               DSPGV computes all eigenvalues and, optionally,
00050 *               eigenvectors of a real symmetric-definite generalized
00051 *               eigenproblem in packed storage.
00052 *
00053 *               DSPGVD computes all eigenvalues and, optionally,
00054 *               eigenvectors of a real symmetric-definite generalized
00055 *               eigenproblem in packed storage using a divide and
00056 *               conquer algorithm.
00057 *
00058 *               DSPGVX computes selected eigenvalues and, optionally,
00059 *               eigenvectors of a real symmetric-definite generalized
00060 *               eigenproblem in packed storage.
00061 *
00062 *               DSBGV computes all eigenvalues and, optionally,
00063 *               eigenvectors of a real symmetric-definite banded
00064 *               generalized eigenproblem.
00065 *
00066 *               DSBGVD computes all eigenvalues and, optionally,
00067 *               eigenvectors of a real symmetric-definite banded
00068 *               generalized eigenproblem using a divide and conquer
00069 *               algorithm.
00070 *
00071 *               DSBGVX computes selected eigenvalues and, optionally,
00072 *               eigenvectors of a real symmetric-definite banded
00073 *               generalized eigenproblem.
00074 *
00075 *       When DDRVSG is called, a number of matrix "sizes" ("n's") and a
00076 *       number of matrix "types" are specified.  For each size ("n")
00077 *       and each type of matrix, one matrix A of the given type will be
00078 *       generated; a random well-conditioned matrix B is also generated
00079 *       and the pair (A,B) is used to test the drivers.
00080 *
00081 *       For each pair (A,B), the following tests are performed:
00082 *
00083 *       (1) DSYGV with ITYPE = 1 and UPLO ='U':
00084 *
00085 *               | A Z - B Z D | / ( |A| |Z| n ulp )
00086 *
00087 *       (2) as (1) but calling DSPGV
00088 *       (3) as (1) but calling DSBGV
00089 *       (4) as (1) but with UPLO = 'L'
00090 *       (5) as (4) but calling DSPGV
00091 *       (6) as (4) but calling DSBGV
00092 *
00093 *       (7) DSYGV with ITYPE = 2 and UPLO ='U':
00094 *
00095 *               | A B Z - Z D | / ( |A| |Z| n ulp )
00096 *
00097 *       (8) as (7) but calling DSPGV
00098 *       (9) as (7) but with UPLO = 'L'
00099 *       (10) as (9) but calling DSPGV
00100 *
00101 *       (11) DSYGV with ITYPE = 3 and UPLO ='U':
00102 *
00103 *               | B A Z - Z D | / ( |A| |Z| n ulp )
00104 *
00105 *       (12) as (11) but calling DSPGV
00106 *       (13) as (11) but with UPLO = 'L'
00107 *       (14) as (13) but calling DSPGV
00108 *
00109 *       DSYGVD, DSPGVD and DSBGVD performed the same 14 tests.
00110 *
00111 *       DSYGVX, DSPGVX and DSBGVX performed the above 14 tests with
00112 *       the parameter RANGE = 'A', 'N' and 'I', respectively.
00113 *
00114 *       The "sizes" are specified by an array NN(1:NSIZES); the value
00115 *       of each element NN(j) specifies one size.
00116 *       The "types" are specified by a logical array DOTYPE( 1:NTYPES );
00117 *       if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
00118 *       This type is used for the matrix A which has half-bandwidth KA.
00119 *       B is generated as a well-conditioned positive definite matrix
00120 *       with half-bandwidth KB (<= KA).
00121 *       Currently, the list of possible types for A is:
00122 *
00123 *       (1)  The zero matrix.
00124 *       (2)  The identity matrix.
00125 *
00126 *       (3)  A diagonal matrix with evenly spaced entries
00127 *            1, ..., ULP  and random signs.
00128 *            (ULP = (first number larger than 1) - 1 )
00129 *       (4)  A diagonal matrix with geometrically spaced entries
00130 *            1, ..., ULP  and random signs.
00131 *       (5)  A diagonal matrix with "clustered" entries
00132 *            1, ULP, ..., ULP and random signs.
00133 *
00134 *       (6)  Same as (4), but multiplied by SQRT( overflow threshold )
00135 *       (7)  Same as (4), but multiplied by SQRT( underflow threshold )
00136 *
00137 *       (8)  A matrix of the form  U* D U, where U is orthogonal and
00138 *            D has evenly spaced entries 1, ..., ULP with random signs
00139 *            on the diagonal.
00140 *
00141 *       (9)  A matrix of the form  U* D U, where U is orthogonal and
00142 *            D has geometrically spaced entries 1, ..., ULP with random
00143 *            signs on the diagonal.
00144 *
00145 *       (10) A matrix of the form  U* D U, where U is orthogonal and
00146 *            D has "clustered" entries 1, ULP,..., ULP with random
00147 *            signs on the diagonal.
00148 *
00149 *       (11) Same as (8), but multiplied by SQRT( overflow threshold )
00150 *       (12) Same as (8), but multiplied by SQRT( underflow threshold )
00151 *
00152 *       (13) symmetric matrix with random entries chosen from (-1,1).
00153 *       (14) Same as (13), but multiplied by SQRT( overflow threshold )
00154 *       (15) Same as (13), but multiplied by SQRT( underflow threshold)
00155 *
00156 *       (16) Same as (8), but with KA = 1 and KB = 1
00157 *       (17) Same as (8), but with KA = 2 and KB = 1
00158 *       (18) Same as (8), but with KA = 2 and KB = 2
00159 *       (19) Same as (8), but with KA = 3 and KB = 1
00160 *       (20) Same as (8), but with KA = 3 and KB = 2
00161 *       (21) Same as (8), but with KA = 3 and KB = 3
00162 *
00163 *  Arguments
00164 *  =========
00165 *
00166 *  NSIZES  INTEGER
00167 *          The number of sizes of matrices to use.  If it is zero,
00168 *          DDRVSG does nothing.  It must be at least zero.
00169 *          Not modified.
00170 *
00171 *  NN      INTEGER array, dimension (NSIZES)
00172 *          An array containing the sizes to be used for the matrices.
00173 *          Zero values will be skipped.  The values must be at least
00174 *          zero.
00175 *          Not modified.
00176 *
00177 *  NTYPES  INTEGER
00178 *          The number of elements in DOTYPE.   If it is zero, DDRVSG
00179 *          does nothing.  It must be at least zero.  If it is MAXTYP+1
00180 *          and NSIZES is 1, then an additional type, MAXTYP+1 is
00181 *          defined, which is to use whatever matrix is in A.  This
00182 *          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
00183 *          DOTYPE(MAXTYP+1) is .TRUE. .
00184 *          Not modified.
00185 *
00186 *  DOTYPE  LOGICAL array, dimension (NTYPES)
00187 *          If DOTYPE(j) is .TRUE., then for each size in NN a
00188 *          matrix of that size and of type j will be generated.
00189 *          If NTYPES is smaller than the maximum number of types
00190 *          defined (PARAMETER MAXTYP), then types NTYPES+1 through
00191 *          MAXTYP will not be generated.  If NTYPES is larger
00192 *          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
00193 *          will be ignored.
00194 *          Not modified.
00195 *
00196 *  ISEED   INTEGER array, dimension (4)
00197 *          On entry ISEED specifies the seed of the random number
00198 *          generator. The array elements should be between 0 and 4095;
00199 *          if not they will be reduced mod 4096.  Also, ISEED(4) must
00200 *          be odd.  The random number generator uses a linear
00201 *          congruential sequence limited to small integers, and so
00202 *          should produce machine independent random numbers. The
00203 *          values of ISEED are changed on exit, and can be used in the
00204 *          next call to DDRVSG to continue the same random number
00205 *          sequence.
00206 *          Modified.
00207 *
00208 *  THRESH  DOUBLE PRECISION
00209 *          A test will count as "failed" if the "error", computed as
00210 *          described above, exceeds THRESH.  Note that the error
00211 *          is scaled to be O(1), so THRESH should be a reasonably
00212 *          small multiple of 1, e.g., 10 or 100.  In particular,
00213 *          it should not depend on the precision (single vs. double)
00214 *          or the size of the matrix.  It must be at least zero.
00215 *          Not modified.
00216 *
00217 *  NOUNIT  INTEGER
00218 *          The FORTRAN unit number for printing out error messages
00219 *          (e.g., if a routine returns IINFO not equal to 0.)
00220 *          Not modified.
00221 *
00222 *  A       DOUBLE PRECISION array, dimension (LDA , max(NN))
00223 *          Used to hold the matrix whose eigenvalues are to be
00224 *          computed.  On exit, A contains the last matrix actually
00225 *          used.
00226 *          Modified.
00227 *
00228 *  LDA     INTEGER
00229 *          The leading dimension of A and AB.  It must be at
00230 *          least 1 and at least max( NN ).
00231 *          Not modified.
00232 *
00233 *  B       DOUBLE PRECISION array, dimension (LDB , max(NN))
00234 *          Used to hold the symmetric positive definite matrix for
00235 *          the generailzed problem.
00236 *          On exit, B contains the last matrix actually
00237 *          used.
00238 *          Modified.
00239 *
00240 *  LDB     INTEGER
00241 *          The leading dimension of B and BB.  It must be at
00242 *          least 1 and at least max( NN ).
00243 *          Not modified.
00244 *
00245 *  D       DOUBLE PRECISION array, dimension (max(NN))
00246 *          The eigenvalues of A. On exit, the eigenvalues in D
00247 *          correspond with the matrix in A.
00248 *          Modified.
00249 *
00250 *  Z       DOUBLE PRECISION array, dimension (LDZ, max(NN))
00251 *          The matrix of eigenvectors.
00252 *          Modified.
00253 *
00254 *  LDZ     INTEGER
00255 *          The leading dimension of Z.  It must be at least 1 and
00256 *          at least max( NN ).
00257 *          Not modified.
00258 *
00259 *  AB      DOUBLE PRECISION array, dimension (LDA, max(NN))
00260 *          Workspace.
00261 *          Modified.
00262 *
00263 *  BB      DOUBLE PRECISION array, dimension (LDB, max(NN))
00264 *          Workspace.
00265 *          Modified.
00266 *
00267 *  AP      DOUBLE PRECISION array, dimension (max(NN)**2)
00268 *          Workspace.
00269 *          Modified.
00270 *
00271 *  BP      DOUBLE PRECISION array, dimension (max(NN)**2)
00272 *          Workspace.
00273 *          Modified.
00274 *
00275 *  WORK    DOUBLE PRECISION array, dimension (NWORK)
00276 *          Workspace.
00277 *          Modified.
00278 *
00279 *  NWORK   INTEGER
00280 *          The number of entries in WORK.  This must be at least
00281 *          1+5*N+2*N*lg(N)+3*N**2 where N = max( NN(j) ) and
00282 *          lg( N ) = smallest integer k such that 2**k >= N.
00283 *          Not modified.
00284 *
00285 *  IWORK   INTEGER array, dimension (LIWORK)
00286 *          Workspace.
00287 *          Modified.
00288 *
00289 *  LIWORK  INTEGER
00290 *          The number of entries in WORK.  This must be at least 6*N.
00291 *          Not modified.
00292 *
00293 *  RESULT  DOUBLE PRECISION array, dimension (70)
00294 *          The values computed by the 70 tests described above.
00295 *          Modified.
00296 *
00297 *  INFO    INTEGER
00298 *          If 0, then everything ran OK.
00299 *           -1: NSIZES < 0
00300 *           -2: Some NN(j) < 0
00301 *           -3: NTYPES < 0
00302 *           -5: THRESH < 0
00303 *           -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
00304 *          -16: LDZ < 1 or LDZ < NMAX.
00305 *          -21: NWORK too small.
00306 *          -23: LIWORK too small.
00307 *          If  DLATMR, SLATMS, DSYGV, DSPGV, DSBGV, SSYGVD, SSPGVD,
00308 *              DSBGVD, DSYGVX, DSPGVX or SSBGVX returns an error code,
00309 *              the absolute value of it is returned.
00310 *          Modified.
00311 *
00312 * ----------------------------------------------------------------------
00313 *
00314 *       Some Local Variables and Parameters:
00315 *       ---- ----- --------- --- ----------
00316 *       ZERO, ONE       Real 0 and 1.
00317 *       MAXTYP          The number of types defined.
00318 *       NTEST           The number of tests that have been run
00319 *                       on this matrix.
00320 *       NTESTT          The total number of tests for this call.
00321 *       NMAX            Largest value in NN.
00322 *       NMATS           The number of matrices generated so far.
00323 *       NERRS           The number of tests which have exceeded THRESH
00324 *                       so far (computed by DLAFTS).
00325 *       COND, IMODE     Values to be passed to the matrix generators.
00326 *       ANORM           Norm of A; passed to matrix generators.
00327 *
00328 *       OVFL, UNFL      Overflow and underflow thresholds.
00329 *       ULP, ULPINV     Finest relative precision and its inverse.
00330 *       RTOVFL, RTUNFL  Square roots of the previous 2 values.
00331 *               The following four arrays decode JTYPE:
00332 *       KTYPE(j)        The general type (1-10) for type "j".
00333 *       KMODE(j)        The MODE value to be passed to the matrix
00334 *                       generator for type "j".
00335 *       KMAGN(j)        The order of magnitude ( O(1),
00336 *                       O(overflow^(1/2) ), O(underflow^(1/2) )
00337 *
00338 *  =====================================================================
00339 *
00340 *     .. Parameters ..
00341       DOUBLE PRECISION   ZERO, ONE, TEN
00342       PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0, TEN = 10.0D0 )
00343       INTEGER            MAXTYP
00344       PARAMETER          ( MAXTYP = 21 )
00345 *     ..
00346 *     .. Local Scalars ..
00347       LOGICAL            BADNN
00348       CHARACTER          UPLO
00349       INTEGER            I, IBTYPE, IBUPLO, IINFO, IJ, IL, IMODE, ITEMP,
00350      $                   ITYPE, IU, J, JCOL, JSIZE, JTYPE, KA, KA9, KB,
00351      $                   KB9, M, MTYPES, N, NERRS, NMATS, NMAX, NTEST,
00352      $                   NTESTT
00353       DOUBLE PRECISION   ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
00354      $                   RTUNFL, ULP, ULPINV, UNFL, VL, VU
00355 *     ..
00356 *     .. Local Arrays ..
00357       INTEGER            IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
00358      $                   KMAGN( MAXTYP ), KMODE( MAXTYP ),
00359      $                   KTYPE( MAXTYP )
00360 *     ..
00361 *     .. External Functions ..
00362       LOGICAL            LSAME
00363       DOUBLE PRECISION   DLAMCH, DLARND
00364       EXTERNAL           LSAME, DLAMCH, DLARND
00365 *     ..
00366 *     .. External Subroutines ..
00367       EXTERNAL           DLABAD, DLACPY, DLAFTS, DLASET, DLASUM, DLATMR,
00368      $                   DLATMS, DSBGV, DSBGVD, DSBGVX, DSGT01, DSPGV,
00369      $                   DSPGVD, DSPGVX, DSYGV, DSYGVD, DSYGVX, XERBLA
00370 *     ..
00371 *     .. Intrinsic Functions ..
00372       INTRINSIC          ABS, DBLE, MAX, MIN, SQRT
00373 *     ..
00374 *     .. Data statements ..
00375       DATA               KTYPE / 1, 2, 5*4, 5*5, 3*8, 6*9 /
00376       DATA               KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
00377      $                   2, 3, 6*1 /
00378       DATA               KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
00379      $                   0, 0, 6*4 /
00380 *     ..
00381 *     .. Executable Statements ..
00382 *
00383 *     1)      Check for errors
00384 *
00385       NTESTT = 0
00386       INFO = 0
00387 *
00388       BADNN = .FALSE.
00389       NMAX = 0
00390       DO 10 J = 1, NSIZES
00391          NMAX = MAX( NMAX, NN( J ) )
00392          IF( NN( J ).LT.0 )
00393      $      BADNN = .TRUE.
00394    10 CONTINUE
00395 *
00396 *     Check for errors
00397 *
00398       IF( NSIZES.LT.0 ) THEN
00399          INFO = -1
00400       ELSE IF( BADNN ) THEN
00401          INFO = -2
00402       ELSE IF( NTYPES.LT.0 ) THEN
00403          INFO = -3
00404       ELSE IF( LDA.LE.1 .OR. LDA.LT.NMAX ) THEN
00405          INFO = -9
00406       ELSE IF( LDZ.LE.1 .OR. LDZ.LT.NMAX ) THEN
00407          INFO = -16
00408       ELSE IF( 2*MAX( NMAX, 3 )**2.GT.NWORK ) THEN
00409          INFO = -21
00410       ELSE IF( 2*MAX( NMAX, 3 )**2.GT.LIWORK ) THEN
00411          INFO = -23
00412       END IF
00413 *
00414       IF( INFO.NE.0 ) THEN
00415          CALL XERBLA( 'DDRVSG', -INFO )
00416          RETURN
00417       END IF
00418 *
00419 *     Quick return if possible
00420 *
00421       IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 )
00422      $   RETURN
00423 *
00424 *     More Important constants
00425 *
00426       UNFL = DLAMCH( 'Safe minimum' )
00427       OVFL = DLAMCH( 'Overflow' )
00428       CALL DLABAD( UNFL, OVFL )
00429       ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' )
00430       ULPINV = ONE / ULP
00431       RTUNFL = SQRT( UNFL )
00432       RTOVFL = SQRT( OVFL )
00433 *
00434       DO 20 I = 1, 4
00435          ISEED2( I ) = ISEED( I )
00436    20 CONTINUE
00437 *
00438 *     Loop over sizes, types
00439 *
00440       NERRS = 0
00441       NMATS = 0
00442 *
00443       DO 650 JSIZE = 1, NSIZES
00444          N = NN( JSIZE )
00445          ANINV = ONE / DBLE( MAX( 1, N ) )
00446 *
00447          IF( NSIZES.NE.1 ) THEN
00448             MTYPES = MIN( MAXTYP, NTYPES )
00449          ELSE
00450             MTYPES = MIN( MAXTYP+1, NTYPES )
00451          END IF
00452 *
00453          KA9 = 0
00454          KB9 = 0
00455          DO 640 JTYPE = 1, MTYPES
00456             IF( .NOT.DOTYPE( JTYPE ) )
00457      $         GO TO 640
00458             NMATS = NMATS + 1
00459             NTEST = 0
00460 *
00461             DO 30 J = 1, 4
00462                IOLDSD( J ) = ISEED( J )
00463    30       CONTINUE
00464 *
00465 *           2)      Compute "A"
00466 *
00467 *                   Control parameters:
00468 *
00469 *               KMAGN  KMODE        KTYPE
00470 *           =1  O(1)   clustered 1  zero
00471 *           =2  large  clustered 2  identity
00472 *           =3  small  exponential  (none)
00473 *           =4         arithmetic   diagonal, w/ eigenvalues
00474 *           =5         random log   hermitian, w/ eigenvalues
00475 *           =6         random       (none)
00476 *           =7                      random diagonal
00477 *           =8                      random hermitian
00478 *           =9                      banded, w/ eigenvalues
00479 *
00480             IF( MTYPES.GT.MAXTYP )
00481      $         GO TO 90
00482 *
00483             ITYPE = KTYPE( JTYPE )
00484             IMODE = KMODE( JTYPE )
00485 *
00486 *           Compute norm
00487 *
00488             GO TO ( 40, 50, 60 )KMAGN( JTYPE )
00489 *
00490    40       CONTINUE
00491             ANORM = ONE
00492             GO TO 70
00493 *
00494    50       CONTINUE
00495             ANORM = ( RTOVFL*ULP )*ANINV
00496             GO TO 70
00497 *
00498    60       CONTINUE
00499             ANORM = RTUNFL*N*ULPINV
00500             GO TO 70
00501 *
00502    70       CONTINUE
00503 *
00504             IINFO = 0
00505             COND = ULPINV
00506 *
00507 *           Special Matrices -- Identity & Jordan block
00508 *
00509             IF( ITYPE.EQ.1 ) THEN
00510 *
00511 *              Zero
00512 *
00513                KA = 0
00514                KB = 0
00515                CALL DLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA )
00516 *
00517             ELSE IF( ITYPE.EQ.2 ) THEN
00518 *
00519 *              Identity
00520 *
00521                KA = 0
00522                KB = 0
00523                CALL DLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA )
00524                DO 80 JCOL = 1, N
00525                   A( JCOL, JCOL ) = ANORM
00526    80          CONTINUE
00527 *
00528             ELSE IF( ITYPE.EQ.4 ) THEN
00529 *
00530 *              Diagonal Matrix, [Eigen]values Specified
00531 *
00532                KA = 0
00533                KB = 0
00534                CALL DLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
00535      $                      ANORM, 0, 0, 'N', A, LDA, WORK( N+1 ),
00536      $                      IINFO )
00537 *
00538             ELSE IF( ITYPE.EQ.5 ) THEN
00539 *
00540 *              symmetric, eigenvalues specified
00541 *
00542                KA = MAX( 0, N-1 )
00543                KB = KA
00544                CALL DLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
00545      $                      ANORM, N, N, 'N', A, LDA, WORK( N+1 ),
00546      $                      IINFO )
00547 *
00548             ELSE IF( ITYPE.EQ.7 ) THEN
00549 *
00550 *              Diagonal, random eigenvalues
00551 *
00552                KA = 0
00553                KB = 0
00554                CALL DLATMR( N, N, 'S', ISEED, 'S', WORK, 6, ONE, ONE,
00555      $                      'T', 'N', WORK( N+1 ), 1, ONE,
00556      $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
00557      $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
00558 *
00559             ELSE IF( ITYPE.EQ.8 ) THEN
00560 *
00561 *              symmetric, random eigenvalues
00562 *
00563                KA = MAX( 0, N-1 )
00564                KB = KA
00565                CALL DLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, ONE,
00566      $                      'T', 'N', WORK( N+1 ), 1, ONE,
00567      $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N,
00568      $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
00569 *
00570             ELSE IF( ITYPE.EQ.9 ) THEN
00571 *
00572 *              symmetric banded, eigenvalues specified
00573 *
00574 *              The following values are used for the half-bandwidths:
00575 *
00576 *                ka = 1   kb = 1
00577 *                ka = 2   kb = 1
00578 *                ka = 2   kb = 2
00579 *                ka = 3   kb = 1
00580 *                ka = 3   kb = 2
00581 *                ka = 3   kb = 3
00582 *
00583                KB9 = KB9 + 1
00584                IF( KB9.GT.KA9 ) THEN
00585                   KA9 = KA9 + 1
00586                   KB9 = 1
00587                END IF
00588                KA = MAX( 0, MIN( N-1, KA9 ) )
00589                KB = MAX( 0, MIN( N-1, KB9 ) )
00590                CALL DLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
00591      $                      ANORM, KA, KA, 'N', A, LDA, WORK( N+1 ),
00592      $                      IINFO )
00593 *
00594             ELSE
00595 *
00596                IINFO = 1
00597             END IF
00598 *
00599             IF( IINFO.NE.0 ) THEN
00600                WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE,
00601      $            IOLDSD
00602                INFO = ABS( IINFO )
00603                RETURN
00604             END IF
00605 *
00606    90       CONTINUE
00607 *
00608             ABSTOL = UNFL + UNFL
00609             IF( N.LE.1 ) THEN
00610                IL = 1
00611                IU = N
00612             ELSE
00613                IL = 1 + ( N-1 )*DLARND( 1, ISEED2 )
00614                IU = 1 + ( N-1 )*DLARND( 1, ISEED2 )
00615                IF( IL.GT.IU ) THEN
00616                   ITEMP = IL
00617                   IL = IU
00618                   IU = ITEMP
00619                END IF
00620             END IF
00621 *
00622 *           3) Call DSYGV, DSPGV, DSBGV, SSYGVD, SSPGVD, SSBGVD,
00623 *              DSYGVX, DSPGVX, and DSBGVX, do tests.
00624 *
00625 *           loop over the three generalized problems
00626 *                 IBTYPE = 1: A*x = (lambda)*B*x
00627 *                 IBTYPE = 2: A*B*x = (lambda)*x
00628 *                 IBTYPE = 3: B*A*x = (lambda)*x
00629 *
00630             DO 630 IBTYPE = 1, 3
00631 *
00632 *              loop over the setting UPLO
00633 *
00634                DO 620 IBUPLO = 1, 2
00635                   IF( IBUPLO.EQ.1 )
00636      $               UPLO = 'U'
00637                   IF( IBUPLO.EQ.2 )
00638      $               UPLO = 'L'
00639 *
00640 *                 Generate random well-conditioned positive definite
00641 *                 matrix B, of bandwidth not greater than that of A.
00642 *
00643                   CALL DLATMS( N, N, 'U', ISEED, 'P', WORK, 5, TEN, ONE,
00644      $                         KB, KB, UPLO, B, LDB, WORK( N+1 ),
00645      $                         IINFO )
00646 *
00647 *                 Test DSYGV
00648 *
00649                   NTEST = NTEST + 1
00650 *
00651                   CALL DLACPY( ' ', N, N, A, LDA, Z, LDZ )
00652                   CALL DLACPY( UPLO, N, N, B, LDB, BB, LDB )
00653 *
00654                   CALL DSYGV( IBTYPE, 'V', UPLO, N, Z, LDZ, BB, LDB, D,
00655      $                        WORK, NWORK, IINFO )
00656                   IF( IINFO.NE.0 ) THEN
00657                      WRITE( NOUNIT, FMT = 9999 )'DSYGV(V,' // UPLO //
00658      $                  ')', IINFO, N, JTYPE, IOLDSD
00659                      INFO = ABS( IINFO )
00660                      IF( IINFO.LT.0 ) THEN
00661                         RETURN
00662                      ELSE
00663                         RESULT( NTEST ) = ULPINV
00664                         GO TO 100
00665                      END IF
00666                   END IF
00667 *
00668 *                 Do Test
00669 *
00670                   CALL DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
00671      $                         LDZ, D, WORK, RESULT( NTEST ) )
00672 *
00673 *                 Test DSYGVD
00674 *
00675                   NTEST = NTEST + 1
00676 *
00677                   CALL DLACPY( ' ', N, N, A, LDA, Z, LDZ )
00678                   CALL DLACPY( UPLO, N, N, B, LDB, BB, LDB )
00679 *
00680                   CALL DSYGVD( IBTYPE, 'V', UPLO, N, Z, LDZ, BB, LDB, D,
00681      $                         WORK, NWORK, IWORK, LIWORK, IINFO )
00682                   IF( IINFO.NE.0 ) THEN
00683                      WRITE( NOUNIT, FMT = 9999 )'DSYGVD(V,' // UPLO //
00684      $                  ')', IINFO, N, JTYPE, IOLDSD
00685                      INFO = ABS( IINFO )
00686                      IF( IINFO.LT.0 ) THEN
00687                         RETURN
00688                      ELSE
00689                         RESULT( NTEST ) = ULPINV
00690                         GO TO 100
00691                      END IF
00692                   END IF
00693 *
00694 *                 Do Test
00695 *
00696                   CALL DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
00697      $                         LDZ, D, WORK, RESULT( NTEST ) )
00698 *
00699 *                 Test DSYGVX
00700 *
00701                   NTEST = NTEST + 1
00702 *
00703                   CALL DLACPY( ' ', N, N, A, LDA, AB, LDA )
00704                   CALL DLACPY( UPLO, N, N, B, LDB, BB, LDB )
00705 *
00706                   CALL DSYGVX( IBTYPE, 'V', 'A', UPLO, N, AB, LDA, BB,
00707      $                         LDB, VL, VU, IL, IU, ABSTOL, M, D, Z,
00708      $                         LDZ, WORK, NWORK, IWORK( N+1 ), IWORK,
00709      $                         IINFO )
00710                   IF( IINFO.NE.0 ) THEN
00711                      WRITE( NOUNIT, FMT = 9999 )'DSYGVX(V,A' // UPLO //
00712      $                  ')', IINFO, N, JTYPE, IOLDSD
00713                      INFO = ABS( IINFO )
00714                      IF( IINFO.LT.0 ) THEN
00715                         RETURN
00716                      ELSE
00717                         RESULT( NTEST ) = ULPINV
00718                         GO TO 100
00719                      END IF
00720                   END IF
00721 *
00722 *                 Do Test
00723 *
00724                   CALL DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
00725      $                         LDZ, D, WORK, RESULT( NTEST ) )
00726 *
00727                   NTEST = NTEST + 1
00728 *
00729                   CALL DLACPY( ' ', N, N, A, LDA, AB, LDA )
00730                   CALL DLACPY( UPLO, N, N, B, LDB, BB, LDB )
00731 *
00732 *                 since we do not know the exact eigenvalues of this
00733 *                 eigenpair, we just set VL and VU as constants.
00734 *                 It is quite possible that there are no eigenvalues
00735 *                 in this interval.
00736 *
00737                   VL = ZERO
00738                   VU = ANORM
00739                   CALL DSYGVX( IBTYPE, 'V', 'V', UPLO, N, AB, LDA, BB,
00740      $                         LDB, VL, VU, IL, IU, ABSTOL, M, D, Z,
00741      $                         LDZ, WORK, NWORK, IWORK( N+1 ), IWORK,
00742      $                         IINFO )
00743                   IF( IINFO.NE.0 ) THEN
00744                      WRITE( NOUNIT, FMT = 9999 )'DSYGVX(V,V,' //
00745      $                  UPLO // ')', IINFO, N, JTYPE, IOLDSD
00746                      INFO = ABS( IINFO )
00747                      IF( IINFO.LT.0 ) THEN
00748                         RETURN
00749                      ELSE
00750                         RESULT( NTEST ) = ULPINV
00751                         GO TO 100
00752                      END IF
00753                   END IF
00754 *
00755 *                 Do Test
00756 *
00757                   CALL DSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
00758      $                         LDZ, D, WORK, RESULT( NTEST ) )
00759 *
00760                   NTEST = NTEST + 1
00761 *
00762                   CALL DLACPY( ' ', N, N, A, LDA, AB, LDA )
00763                   CALL DLACPY( UPLO, N, N, B, LDB, BB, LDB )
00764 *
00765                   CALL DSYGVX( IBTYPE, 'V', 'I', UPLO, N, AB, LDA, BB,
00766      $                         LDB, VL, VU, IL, IU, ABSTOL, M, D, Z,
00767      $                         LDZ, WORK, NWORK, IWORK( N+1 ), IWORK,
00768      $                         IINFO )
00769                   IF( IINFO.NE.0 ) THEN
00770                      WRITE( NOUNIT, FMT = 9999 )'DSYGVX(V,I,' //
00771      $                  UPLO // ')', IINFO, N, JTYPE, IOLDSD
00772                      INFO = ABS( IINFO )
00773                      IF( IINFO.LT.0 ) THEN
00774                         RETURN
00775                      ELSE
00776                         RESULT( NTEST ) = ULPINV
00777                         GO TO 100
00778                      END IF
00779                   END IF
00780 *
00781 *                 Do Test
00782 *
00783                   CALL DSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
00784      $                         LDZ, D, WORK, RESULT( NTEST ) )
00785 *
00786   100             CONTINUE
00787 *
00788 *                 Test DSPGV
00789 *
00790                   NTEST = NTEST + 1
00791 *
00792 *                 Copy the matrices into packed storage.
00793 *
00794                   IF( LSAME( UPLO, 'U' ) ) THEN
00795                      IJ = 1
00796                      DO 120 J = 1, N
00797                         DO 110 I = 1, J
00798                            AP( IJ ) = A( I, J )
00799                            BP( IJ ) = B( I, J )
00800                            IJ = IJ + 1
00801   110                   CONTINUE
00802   120                CONTINUE
00803                   ELSE
00804                      IJ = 1
00805                      DO 140 J = 1, N
00806                         DO 130 I = J, N
00807                            AP( IJ ) = A( I, J )
00808                            BP( IJ ) = B( I, J )
00809                            IJ = IJ + 1
00810   130                   CONTINUE
00811   140                CONTINUE
00812                   END IF
00813 *
00814                   CALL DSPGV( IBTYPE, 'V', UPLO, N, AP, BP, D, Z, LDZ,
00815      $                        WORK, IINFO )
00816                   IF( IINFO.NE.0 ) THEN
00817                      WRITE( NOUNIT, FMT = 9999 )'DSPGV(V,' // UPLO //
00818      $                  ')', IINFO, N, JTYPE, IOLDSD
00819                      INFO = ABS( IINFO )
00820                      IF( IINFO.LT.0 ) THEN
00821                         RETURN
00822                      ELSE
00823                         RESULT( NTEST ) = ULPINV
00824                         GO TO 310
00825                      END IF
00826                   END IF
00827 *
00828 *                 Do Test
00829 *
00830                   CALL DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
00831      $                         LDZ, D, WORK, RESULT( NTEST ) )
00832 *
00833 *                 Test DSPGVD
00834 *
00835                   NTEST = NTEST + 1
00836 *
00837 *                 Copy the matrices into packed storage.
00838 *
00839                   IF( LSAME( UPLO, 'U' ) ) THEN
00840                      IJ = 1
00841                      DO 160 J = 1, N
00842                         DO 150 I = 1, J
00843                            AP( IJ ) = A( I, J )
00844                            BP( IJ ) = B( I, J )
00845                            IJ = IJ + 1
00846   150                   CONTINUE
00847   160                CONTINUE
00848                   ELSE
00849                      IJ = 1
00850                      DO 180 J = 1, N
00851                         DO 170 I = J, N
00852                            AP( IJ ) = A( I, J )
00853                            BP( IJ ) = B( I, J )
00854                            IJ = IJ + 1
00855   170                   CONTINUE
00856   180                CONTINUE
00857                   END IF
00858 *
00859                   CALL DSPGVD( IBTYPE, 'V', UPLO, N, AP, BP, D, Z, LDZ,
00860      $                         WORK, NWORK, IWORK, LIWORK, IINFO )
00861                   IF( IINFO.NE.0 ) THEN
00862                      WRITE( NOUNIT, FMT = 9999 )'DSPGVD(V,' // UPLO //
00863      $                  ')', IINFO, N, JTYPE, IOLDSD
00864                      INFO = ABS( IINFO )
00865                      IF( IINFO.LT.0 ) THEN
00866                         RETURN
00867                      ELSE
00868                         RESULT( NTEST ) = ULPINV
00869                         GO TO 310
00870                      END IF
00871                   END IF
00872 *
00873 *                 Do Test
00874 *
00875                   CALL DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
00876      $                         LDZ, D, WORK, RESULT( NTEST ) )
00877 *
00878 *                 Test DSPGVX
00879 *
00880                   NTEST = NTEST + 1
00881 *
00882 *                 Copy the matrices into packed storage.
00883 *
00884                   IF( LSAME( UPLO, 'U' ) ) THEN
00885                      IJ = 1
00886                      DO 200 J = 1, N
00887                         DO 190 I = 1, J
00888                            AP( IJ ) = A( I, J )
00889                            BP( IJ ) = B( I, J )
00890                            IJ = IJ + 1
00891   190                   CONTINUE
00892   200                CONTINUE
00893                   ELSE
00894                      IJ = 1
00895                      DO 220 J = 1, N
00896                         DO 210 I = J, N
00897                            AP( IJ ) = A( I, J )
00898                            BP( IJ ) = B( I, J )
00899                            IJ = IJ + 1
00900   210                   CONTINUE
00901   220                CONTINUE
00902                   END IF
00903 *
00904                   CALL DSPGVX( IBTYPE, 'V', 'A', UPLO, N, AP, BP, VL,
00905      $                         VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
00906      $                         IWORK( N+1 ), IWORK, INFO )
00907                   IF( IINFO.NE.0 ) THEN
00908                      WRITE( NOUNIT, FMT = 9999 )'DSPGVX(V,A' // UPLO //
00909      $                  ')', IINFO, N, JTYPE, IOLDSD
00910                      INFO = ABS( IINFO )
00911                      IF( IINFO.LT.0 ) THEN
00912                         RETURN
00913                      ELSE
00914                         RESULT( NTEST ) = ULPINV
00915                         GO TO 310
00916                      END IF
00917                   END IF
00918 *
00919 *                 Do Test
00920 *
00921                   CALL DSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
00922      $                         LDZ, D, WORK, RESULT( NTEST ) )
00923 *
00924                   NTEST = NTEST + 1
00925 *
00926 *                 Copy the matrices into packed storage.
00927 *
00928                   IF( LSAME( UPLO, 'U' ) ) THEN
00929                      IJ = 1
00930                      DO 240 J = 1, N
00931                         DO 230 I = 1, J
00932                            AP( IJ ) = A( I, J )
00933                            BP( IJ ) = B( I, J )
00934                            IJ = IJ + 1
00935   230                   CONTINUE
00936   240                CONTINUE
00937                   ELSE
00938                      IJ = 1
00939                      DO 260 J = 1, N
00940                         DO 250 I = J, N
00941                            AP( IJ ) = A( I, J )
00942                            BP( IJ ) = B( I, J )
00943                            IJ = IJ + 1
00944   250                   CONTINUE
00945   260                CONTINUE
00946                   END IF
00947 *
00948                   VL = ZERO
00949                   VU = ANORM
00950                   CALL DSPGVX( IBTYPE, 'V', 'V', UPLO, N, AP, BP, VL,
00951      $                         VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
00952      $                         IWORK( N+1 ), IWORK, INFO )
00953                   IF( IINFO.NE.0 ) THEN
00954                      WRITE( NOUNIT, FMT = 9999 )'DSPGVX(V,V' // UPLO //
00955      $                  ')', IINFO, N, JTYPE, IOLDSD
00956                      INFO = ABS( IINFO )
00957                      IF( IINFO.LT.0 ) THEN
00958                         RETURN
00959                      ELSE
00960                         RESULT( NTEST ) = ULPINV
00961                         GO TO 310
00962                      END IF
00963                   END IF
00964 *
00965 *                 Do Test
00966 *
00967                   CALL DSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
00968      $                         LDZ, D, WORK, RESULT( NTEST ) )
00969 *
00970                   NTEST = NTEST + 1
00971 *
00972 *                 Copy the matrices into packed storage.
00973 *
00974                   IF( LSAME( UPLO, 'U' ) ) THEN
00975                      IJ = 1
00976                      DO 280 J = 1, N
00977                         DO 270 I = 1, J
00978                            AP( IJ ) = A( I, J )
00979                            BP( IJ ) = B( I, J )
00980                            IJ = IJ + 1
00981   270                   CONTINUE
00982   280                CONTINUE
00983                   ELSE
00984                      IJ = 1
00985                      DO 300 J = 1, N
00986                         DO 290 I = J, N
00987                            AP( IJ ) = A( I, J )
00988                            BP( IJ ) = B( I, J )
00989                            IJ = IJ + 1
00990   290                   CONTINUE
00991   300                CONTINUE
00992                   END IF
00993 *
00994                   CALL DSPGVX( IBTYPE, 'V', 'I', UPLO, N, AP, BP, VL,
00995      $                         VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
00996      $                         IWORK( N+1 ), IWORK, INFO )
00997                   IF( IINFO.NE.0 ) THEN
00998                      WRITE( NOUNIT, FMT = 9999 )'DSPGVX(V,I' // UPLO //
00999      $                  ')', IINFO, N, JTYPE, IOLDSD
01000                      INFO = ABS( IINFO )
01001                      IF( IINFO.LT.0 ) THEN
01002                         RETURN
01003                      ELSE
01004                         RESULT( NTEST ) = ULPINV
01005                         GO TO 310
01006                      END IF
01007                   END IF
01008 *
01009 *                 Do Test
01010 *
01011                   CALL DSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
01012      $                         LDZ, D, WORK, RESULT( NTEST ) )
01013 *
01014   310             CONTINUE
01015 *
01016                   IF( IBTYPE.EQ.1 ) THEN
01017 *
01018 *                    TEST DSBGV
01019 *
01020                      NTEST = NTEST + 1
01021 *
01022 *                    Copy the matrices into band storage.
01023 *
01024                      IF( LSAME( UPLO, 'U' ) ) THEN
01025                         DO 340 J = 1, N
01026                            DO 320 I = MAX( 1, J-KA ), J
01027                               AB( KA+1+I-J, J ) = A( I, J )
01028   320                      CONTINUE
01029                            DO 330 I = MAX( 1, J-KB ), J
01030                               BB( KB+1+I-J, J ) = B( I, J )
01031   330                      CONTINUE
01032   340                   CONTINUE
01033                      ELSE
01034                         DO 370 J = 1, N
01035                            DO 350 I = J, MIN( N, J+KA )
01036                               AB( 1+I-J, J ) = A( I, J )
01037   350                      CONTINUE
01038                            DO 360 I = J, MIN( N, J+KB )
01039                               BB( 1+I-J, J ) = B( I, J )
01040   360                      CONTINUE
01041   370                   CONTINUE
01042                      END IF
01043 *
01044                      CALL DSBGV( 'V', UPLO, N, KA, KB, AB, LDA, BB, LDB,
01045      $                           D, Z, LDZ, WORK, IINFO )
01046                      IF( IINFO.NE.0 ) THEN
01047                         WRITE( NOUNIT, FMT = 9999 )'DSBGV(V,' //
01048      $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
01049                         INFO = ABS( IINFO )
01050                         IF( IINFO.LT.0 ) THEN
01051                            RETURN
01052                         ELSE
01053                            RESULT( NTEST ) = ULPINV
01054                            GO TO 620
01055                         END IF
01056                      END IF
01057 *
01058 *                    Do Test
01059 *
01060                      CALL DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
01061      $                            LDZ, D, WORK, RESULT( NTEST ) )
01062 *
01063 *                    TEST DSBGVD
01064 *
01065                      NTEST = NTEST + 1
01066 *
01067 *                    Copy the matrices into band storage.
01068 *
01069                      IF( LSAME( UPLO, 'U' ) ) THEN
01070                         DO 400 J = 1, N
01071                            DO 380 I = MAX( 1, J-KA ), J
01072                               AB( KA+1+I-J, J ) = A( I, J )
01073   380                      CONTINUE
01074                            DO 390 I = MAX( 1, J-KB ), J
01075                               BB( KB+1+I-J, J ) = B( I, J )
01076   390                      CONTINUE
01077   400                   CONTINUE
01078                      ELSE
01079                         DO 430 J = 1, N
01080                            DO 410 I = J, MIN( N, J+KA )
01081                               AB( 1+I-J, J ) = A( I, J )
01082   410                      CONTINUE
01083                            DO 420 I = J, MIN( N, J+KB )
01084                               BB( 1+I-J, J ) = B( I, J )
01085   420                      CONTINUE
01086   430                   CONTINUE
01087                      END IF
01088 *
01089                      CALL DSBGVD( 'V', UPLO, N, KA, KB, AB, LDA, BB,
01090      $                            LDB, D, Z, LDZ, WORK, NWORK, IWORK,
01091      $                            LIWORK, IINFO )
01092                      IF( IINFO.NE.0 ) THEN
01093                         WRITE( NOUNIT, FMT = 9999 )'DSBGVD(V,' //
01094      $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
01095                         INFO = ABS( IINFO )
01096                         IF( IINFO.LT.0 ) THEN
01097                            RETURN
01098                         ELSE
01099                            RESULT( NTEST ) = ULPINV
01100                            GO TO 620
01101                         END IF
01102                      END IF
01103 *
01104 *                    Do Test
01105 *
01106                      CALL DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
01107      $                            LDZ, D, WORK, RESULT( NTEST ) )
01108 *
01109 *                    Test DSBGVX
01110 *
01111                      NTEST = NTEST + 1
01112 *
01113 *                    Copy the matrices into band storage.
01114 *
01115                      IF( LSAME( UPLO, 'U' ) ) THEN
01116                         DO 460 J = 1, N
01117                            DO 440 I = MAX( 1, J-KA ), J
01118                               AB( KA+1+I-J, J ) = A( I, J )
01119   440                      CONTINUE
01120                            DO 450 I = MAX( 1, J-KB ), J
01121                               BB( KB+1+I-J, J ) = B( I, J )
01122   450                      CONTINUE
01123   460                   CONTINUE
01124                      ELSE
01125                         DO 490 J = 1, N
01126                            DO 470 I = J, MIN( N, J+KA )
01127                               AB( 1+I-J, J ) = A( I, J )
01128   470                      CONTINUE
01129                            DO 480 I = J, MIN( N, J+KB )
01130                               BB( 1+I-J, J ) = B( I, J )
01131   480                      CONTINUE
01132   490                   CONTINUE
01133                      END IF
01134 *
01135                      CALL DSBGVX( 'V', 'A', UPLO, N, KA, KB, AB, LDA,
01136      $                            BB, LDB, BP, MAX( 1, N ), VL, VU, IL,
01137      $                            IU, ABSTOL, M, D, Z, LDZ, WORK,
01138      $                            IWORK( N+1 ), IWORK, IINFO )
01139                      IF( IINFO.NE.0 ) THEN
01140                         WRITE( NOUNIT, FMT = 9999 )'DSBGVX(V,A' //
01141      $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
01142                         INFO = ABS( IINFO )
01143                         IF( IINFO.LT.0 ) THEN
01144                            RETURN
01145                         ELSE
01146                            RESULT( NTEST ) = ULPINV
01147                            GO TO 620
01148                         END IF
01149                      END IF
01150 *
01151 *                    Do Test
01152 *
01153                      CALL DSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
01154      $                            LDZ, D, WORK, RESULT( NTEST ) )
01155 *
01156 *
01157                      NTEST = NTEST + 1
01158 *
01159 *                    Copy the matrices into band storage.
01160 *
01161                      IF( LSAME( UPLO, 'U' ) ) THEN
01162                         DO 520 J = 1, N
01163                            DO 500 I = MAX( 1, J-KA ), J
01164                               AB( KA+1+I-J, J ) = A( I, J )
01165   500                      CONTINUE
01166                            DO 510 I = MAX( 1, J-KB ), J
01167                               BB( KB+1+I-J, J ) = B( I, J )
01168   510                      CONTINUE
01169   520                   CONTINUE
01170                      ELSE
01171                         DO 550 J = 1, N
01172                            DO 530 I = J, MIN( N, J+KA )
01173                               AB( 1+I-J, J ) = A( I, J )
01174   530                      CONTINUE
01175                            DO 540 I = J, MIN( N, J+KB )
01176                               BB( 1+I-J, J ) = B( I, J )
01177   540                      CONTINUE
01178   550                   CONTINUE
01179                      END IF
01180 *
01181                      VL = ZERO
01182                      VU = ANORM
01183                      CALL DSBGVX( 'V', 'V', UPLO, N, KA, KB, AB, LDA,
01184      $                            BB, LDB, BP, MAX( 1, N ), VL, VU, IL,
01185      $                            IU, ABSTOL, M, D, Z, LDZ, WORK,
01186      $                            IWORK( N+1 ), IWORK, IINFO )
01187                      IF( IINFO.NE.0 ) THEN
01188                         WRITE( NOUNIT, FMT = 9999 )'DSBGVX(V,V' //
01189      $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
01190                         INFO = ABS( IINFO )
01191                         IF( IINFO.LT.0 ) THEN
01192                            RETURN
01193                         ELSE
01194                            RESULT( NTEST ) = ULPINV
01195                            GO TO 620
01196                         END IF
01197                      END IF
01198 *
01199 *                    Do Test
01200 *
01201                      CALL DSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
01202      $                            LDZ, D, WORK, RESULT( NTEST ) )
01203 *
01204                      NTEST = NTEST + 1
01205 *
01206 *                    Copy the matrices into band storage.
01207 *
01208                      IF( LSAME( UPLO, 'U' ) ) THEN
01209                         DO 580 J = 1, N
01210                            DO 560 I = MAX( 1, J-KA ), J
01211                               AB( KA+1+I-J, J ) = A( I, J )
01212   560                      CONTINUE
01213                            DO 570 I = MAX( 1, J-KB ), J
01214                               BB( KB+1+I-J, J ) = B( I, J )
01215   570                      CONTINUE
01216   580                   CONTINUE
01217                      ELSE
01218                         DO 610 J = 1, N
01219                            DO 590 I = J, MIN( N, J+KA )
01220                               AB( 1+I-J, J ) = A( I, J )
01221   590                      CONTINUE
01222                            DO 600 I = J, MIN( N, J+KB )
01223                               BB( 1+I-J, J ) = B( I, J )
01224   600                      CONTINUE
01225   610                   CONTINUE
01226                      END IF
01227 *
01228                      CALL DSBGVX( 'V', 'I', UPLO, N, KA, KB, AB, LDA,
01229      $                            BB, LDB, BP, MAX( 1, N ), VL, VU, IL,
01230      $                            IU, ABSTOL, M, D, Z, LDZ, WORK,
01231      $                            IWORK( N+1 ), IWORK, IINFO )
01232                      IF( IINFO.NE.0 ) THEN
01233                         WRITE( NOUNIT, FMT = 9999 )'DSBGVX(V,I' //
01234      $                     UPLO // ')', IINFO, N, JTYPE, IOLDSD
01235                         INFO = ABS( IINFO )
01236                         IF( IINFO.LT.0 ) THEN
01237                            RETURN
01238                         ELSE
01239                            RESULT( NTEST ) = ULPINV
01240                            GO TO 620
01241                         END IF
01242                      END IF
01243 *
01244 *                    Do Test
01245 *
01246                      CALL DSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
01247      $                            LDZ, D, WORK, RESULT( NTEST ) )
01248 *
01249                   END IF
01250 *
01251   620          CONTINUE
01252   630       CONTINUE
01253 *
01254 *           End of Loop -- Check for RESULT(j) > THRESH
01255 *
01256             NTESTT = NTESTT + NTEST
01257             CALL DLAFTS( 'DSG', N, N, JTYPE, NTEST, RESULT, IOLDSD,
01258      $                   THRESH, NOUNIT, NERRS )
01259   640    CONTINUE
01260   650 CONTINUE
01261 *
01262 *     Summary
01263 *
01264       CALL DLASUM( 'DSG', NOUNIT, NERRS, NTESTT )
01265 *
01266       RETURN
01267 *
01268 *     End of DDRVSG
01269 *
01270  9999 FORMAT( ' DDRVSG: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
01271      $      I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
01272       END