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