LAPACK: TESTING/EIG/ddrvst.f Source File

Go to the documentation of this file.
00001       SUBROUTINE DDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
00002      $                   NOUNIT, A, LDA, D1, D2, D3, D4, EVEIGS, WA1,
00003      $                   WA2, WA3, U, LDU, V, TAU, Z, WORK, LWORK,
00004      $                   IWORK, LIWORK, RESULT, INFO )
00005 *
00006 *  -- LAPACK test routine (version 3.1) --
00007 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00008 *     November 2006
00009 *
00010 *     .. Scalar Arguments ..
00011       INTEGER            INFO, LDA, LDU, LIWORK, LWORK, NOUNIT, NSIZES,
00012      $                   NTYPES
00013       DOUBLE PRECISION   THRESH
00014 *     ..
00015 *     .. Array Arguments ..
00016       LOGICAL            DOTYPE( * )
00017       INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
00018       DOUBLE PRECISION   A( LDA, * ), D1( * ), D2( * ), D3( * ),
00019      $                   D4( * ), EVEIGS( * ), RESULT( * ), TAU( * ),
00020      $                   U( LDU, * ), V( LDU, * ), WA1( * ), WA2( * ),
00021      $                   WA3( * ), WORK( * ), Z( LDU, * )
00022 *     ..
00023 *
00024 *  Purpose
00025 *  =======
00026 *
00027 *       DDRVST  checks the symmetric eigenvalue problem drivers.
00028 *
00029 *               DSTEV computes all eigenvalues and, optionally,
00030 *               eigenvectors of a real symmetric tridiagonal matrix.
00031 *
00032 *               DSTEVX computes selected eigenvalues and, optionally,
00033 *               eigenvectors of a real symmetric tridiagonal matrix.
00034 *
00035 *               DSTEVR computes selected eigenvalues and, optionally,
00036 *               eigenvectors of a real symmetric tridiagonal matrix
00037 *               using the Relatively Robust Representation where it can.
00038 *
00039 *               DSYEV computes all eigenvalues and, optionally,
00040 *               eigenvectors of a real symmetric matrix.
00041 *
00042 *               DSYEVX computes selected eigenvalues and, optionally,
00043 *               eigenvectors of a real symmetric matrix.
00044 *
00045 *               DSYEVR computes selected eigenvalues and, optionally,
00046 *               eigenvectors of a real symmetric matrix
00047 *               using the Relatively Robust Representation where it can.
00048 *
00049 *               DSPEV computes all eigenvalues and, optionally,
00050 *               eigenvectors of a real symmetric matrix in packed
00051 *               storage.
00052 *
00053 *               DSPEVX computes selected eigenvalues and, optionally,
00054 *               eigenvectors of a real symmetric matrix in packed
00055 *               storage.
00056 *
00057 *               DSBEV computes all eigenvalues and, optionally,
00058 *               eigenvectors of a real symmetric band matrix.
00059 *
00060 *               DSBEVX computes selected eigenvalues and, optionally,
00061 *               eigenvectors of a real symmetric band matrix.
00062 *
00063 *               DSYEVD computes all eigenvalues and, optionally,
00064 *               eigenvectors of a real symmetric matrix using
00065 *               a divide and conquer algorithm.
00066 *
00067 *               DSPEVD computes all eigenvalues and, optionally,
00068 *               eigenvectors of a real symmetric matrix in packed
00069 *               storage, using a divide and conquer algorithm.
00070 *
00071 *               DSBEVD computes all eigenvalues and, optionally,
00072 *               eigenvectors of a real symmetric band matrix,
00073 *               using a divide and conquer algorithm.
00074 *
00075 *       When DDRVST 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 will be generated and used
00078 *       to test the appropriate drivers.  For each matrix and each
00079 *       driver routine called, the following tests will be performed:
00080 *
00081 *       (1)     | A - Z D Z' | / ( |A| n ulp )
00082 *
00083 *       (2)     | I - Z Z' | / ( n ulp )
00084 *
00085 *       (3)     | D1 - D2 | / ( |D1| ulp )
00086 *
00087 *       where Z is the matrix of eigenvectors returned when the
00088 *       eigenvector option is given and D1 and D2 are the eigenvalues
00089 *       returned with and without the eigenvector option.
00090 *
00091 *       The "sizes" are specified by an array NN(1:NSIZES); the value of
00092 *       each element NN(j) specifies one size.
00093 *       The "types" are specified by a logical array DOTYPE( 1:NTYPES );
00094 *       if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
00095 *       Currently, the list of possible types is:
00096 *
00097 *       (1)  The zero matrix.
00098 *       (2)  The identity matrix.
00099 *
00100 *       (3)  A diagonal matrix with evenly spaced eigenvalues
00101 *            1, ..., ULP  and random signs.
00102 *            (ULP = (first number larger than 1) - 1 )
00103 *       (4)  A diagonal matrix with geometrically spaced eigenvalues
00104 *            1, ..., ULP  and random signs.
00105 *       (5)  A diagonal matrix with "clustered" eigenvalues
00106 *            1, ULP, ..., ULP and random signs.
00107 *
00108 *       (6)  Same as (4), but multiplied by SQRT( overflow threshold )
00109 *       (7)  Same as (4), but multiplied by SQRT( underflow threshold )
00110 *
00111 *       (8)  A matrix of the form  U' D U, where U is orthogonal and
00112 *            D has evenly spaced entries 1, ..., ULP with random signs
00113 *            on the diagonal.
00114 *
00115 *       (9)  A matrix of the form  U' D U, where U is orthogonal and
00116 *            D has geometrically spaced entries 1, ..., ULP with random
00117 *            signs on the diagonal.
00118 *
00119 *       (10) A matrix of the form  U' D U, where U is orthogonal and
00120 *            D has "clustered" entries 1, ULP,..., ULP with random
00121 *            signs on the diagonal.
00122 *
00123 *       (11) Same as (8), but multiplied by SQRT( overflow threshold )
00124 *       (12) Same as (8), but multiplied by SQRT( underflow threshold )
00125 *
00126 *       (13) Symmetric matrix with random entries chosen from (-1,1).
00127 *       (14) Same as (13), but multiplied by SQRT( overflow threshold )
00128 *       (15) Same as (13), but multiplied by SQRT( underflow threshold )
00129 *       (16) A band matrix with half bandwidth randomly chosen between
00130 *            0 and N-1, with evenly spaced eigenvalues 1, ..., ULP
00131 *            with random signs.
00132 *       (17) Same as (16), but multiplied by SQRT( overflow threshold )
00133 *       (18) Same as (16), but multiplied by SQRT( underflow threshold )
00134 *
00135 *  Arguments
00136 *  =========
00137 *
00138 *  NSIZES  INTEGER
00139 *          The number of sizes of matrices to use.  If it is zero,
00140 *          DDRVST does nothing.  It must be at least zero.
00141 *          Not modified.
00142 *
00143 *  NN      INTEGER array, dimension (NSIZES)
00144 *          An array containing the sizes to be used for the matrices.
00145 *          Zero values will be skipped.  The values must be at least
00146 *          zero.
00147 *          Not modified.
00148 *
00149 *  NTYPES  INTEGER
00150 *          The number of elements in DOTYPE.   If it is zero, DDRVST
00151 *          does nothing.  It must be at least zero.  If it is MAXTYP+1
00152 *          and NSIZES is 1, then an additional type, MAXTYP+1 is
00153 *          defined, which is to use whatever matrix is in A.  This
00154 *          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
00155 *          DOTYPE(MAXTYP+1) is .TRUE. .
00156 *          Not modified.
00157 *
00158 *  DOTYPE  LOGICAL array, dimension (NTYPES)
00159 *          If DOTYPE(j) is .TRUE., then for each size in NN a
00160 *          matrix of that size and of type j will be generated.
00161 *          If NTYPES is smaller than the maximum number of types
00162 *          defined (PARAMETER MAXTYP), then types NTYPES+1 through
00163 *          MAXTYP will not be generated.  If NTYPES is larger
00164 *          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
00165 *          will be ignored.
00166 *          Not modified.
00167 *
00168 *  ISEED   INTEGER array, dimension (4)
00169 *          On entry ISEED specifies the seed of the random number
00170 *          generator. The array elements should be between 0 and 4095;
00171 *          if not they will be reduced mod 4096.  Also, ISEED(4) must
00172 *          be odd.  The random number generator uses a linear
00173 *          congruential sequence limited to small integers, and so
00174 *          should produce machine independent random numbers. The
00175 *          values of ISEED are changed on exit, and can be used in the
00176 *          next call to DDRVST to continue the same random number
00177 *          sequence.
00178 *          Modified.
00179 *
00180 *  THRESH  DOUBLE PRECISION
00181 *          A test will count as "failed" if the "error", computed as
00182 *          described above, exceeds THRESH.  Note that the error
00183 *          is scaled to be O(1), so THRESH should be a reasonably
00184 *          small multiple of 1, e.g., 10 or 100.  In particular,
00185 *          it should not depend on the precision (single vs. double)
00186 *          or the size of the matrix.  It must be at least zero.
00187 *          Not modified.
00188 *
00189 *  NOUNIT  INTEGER
00190 *          The FORTRAN unit number for printing out error messages
00191 *          (e.g., if a routine returns IINFO not equal to 0.)
00192 *          Not modified.
00193 *
00194 *  A       DOUBLE PRECISION array, dimension (LDA , max(NN))
00195 *          Used to hold the matrix whose eigenvalues are to be
00196 *          computed.  On exit, A contains the last matrix actually
00197 *          used.
00198 *          Modified.
00199 *
00200 *  LDA     INTEGER
00201 *          The leading dimension of A.  It must be at
00202 *          least 1 and at least max( NN ).
00203 *          Not modified.
00204 *
00205 *  D1      DOUBLE PRECISION array, dimension (max(NN))
00206 *          The eigenvalues of A, as computed by DSTEQR simlutaneously
00207 *          with Z.  On exit, the eigenvalues in D1 correspond with the
00208 *          matrix in A.
00209 *          Modified.
00210 *
00211 *  D2      DOUBLE PRECISION array, dimension (max(NN))
00212 *          The eigenvalues of A, as computed by DSTEQR if Z is not
00213 *          computed.  On exit, the eigenvalues in D2 correspond with
00214 *          the matrix in A.
00215 *          Modified.
00216 *
00217 *  D3      DOUBLE PRECISION array, dimension (max(NN))
00218 *          The eigenvalues of A, as computed by DSTERF.  On exit, the
00219 *          eigenvalues in D3 correspond with the matrix in A.
00220 *          Modified.
00221 *
00222 *  D4      DOUBLE PRECISION array, dimension
00223 *
00224 *  EVEIGS  DOUBLE PRECISION array, dimension (max(NN))
00225 *          The eigenvalues as computed by DSTEV('N', ... )
00226 *          (I reserve the right to change this to the output of
00227 *          whichever algorithm computes the most accurate eigenvalues).
00228 *
00229 *  WA1     DOUBLE PRECISION array, dimension
00230 *
00231 *  WA2     DOUBLE PRECISION array, dimension
00232 *
00233 *  WA3     DOUBLE PRECISION array, dimension
00234 *
00235 *  U       DOUBLE PRECISION array, dimension (LDU, max(NN))
00236 *          The orthogonal matrix computed by DSYTRD + DORGTR.
00237 *          Modified.
00238 *
00239 *  LDU     INTEGER
00240 *          The leading dimension of U, Z, and V.  It must be at
00241 *          least 1 and at least max( NN ).
00242 *          Not modified.
00243 *
00244 *  V       DOUBLE PRECISION array, dimension (LDU, max(NN))
00245 *          The Housholder vectors computed by DSYTRD in reducing A to
00246 *          tridiagonal form.
00247 *          Modified.
00248 *
00249 *  TAU     DOUBLE PRECISION array, dimension (max(NN))
00250 *          The Householder factors computed by DSYTRD in reducing A
00251 *          to tridiagonal form.
00252 *          Modified.
00253 *
00254 *  Z       DOUBLE PRECISION array, dimension (LDU, max(NN))
00255 *          The orthogonal matrix of eigenvectors computed by DSTEQR,
00256 *          DPTEQR, and DSTEIN.
00257 *          Modified.
00258 *
00259 *  WORK    DOUBLE PRECISION array, dimension (LWORK)
00260 *          Workspace.
00261 *          Modified.
00262 *
00263 *  LWORK   INTEGER
00264 *          The number of entries in WORK.  This must be at least
00265 *          1 + 4 * Nmax + 2 * Nmax * lg Nmax + 4 * Nmax**2
00266 *          where Nmax = max( NN(j), 2 ) and lg = log base 2.
00267 *          Not modified.
00268 *
00269 *  IWORK   INTEGER array,
00270 *             dimension (6 + 6*Nmax + 5 * Nmax * lg Nmax )
00271 *          where Nmax = max( NN(j), 2 ) and lg = log base 2.
00272 *          Workspace.
00273 *          Modified.
00274 *
00275 *  RESULT  DOUBLE PRECISION array, dimension (105)
00276 *          The values computed by the tests described above.
00277 *          The values are currently limited to 1/ulp, to avoid
00278 *          overflow.
00279 *          Modified.
00280 *
00281 *  INFO    INTEGER
00282 *          If 0, then everything ran OK.
00283 *           -1: NSIZES < 0
00284 *           -2: Some NN(j) < 0
00285 *           -3: NTYPES < 0
00286 *           -5: THRESH < 0
00287 *           -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
00288 *          -16: LDU < 1 or LDU < NMAX.
00289 *          -21: LWORK too small.
00290 *          If  DLATMR, DLATMS, DSYTRD, DORGTR, DSTEQR, DSTERF,
00291 *              or DORMTR returns an error code, the
00292 *              absolute value of it is returned.
00293 *          Modified.
00294 *
00295 *-----------------------------------------------------------------------
00296 *
00297 *       Some Local Variables and Parameters:
00298 *       ---- ----- --------- --- ----------
00299 *       ZERO, ONE       Real 0 and 1.
00300 *       MAXTYP          The number of types defined.
00301 *       NTEST           The number of tests performed, or which can
00302 *                       be performed so far, for the current matrix.
00303 *       NTESTT          The total number of tests performed so far.
00304 *       NMAX            Largest value in NN.
00305 *       NMATS           The number of matrices generated so far.
00306 *       NERRS           The number of tests which have exceeded THRESH
00307 *                       so far (computed by DLAFTS).
00308 *       COND, IMODE     Values to be passed to the matrix generators.
00309 *       ANORM           Norm of A; passed to matrix generators.
00310 *
00311 *       OVFL, UNFL      Overflow and underflow thresholds.
00312 *       ULP, ULPINV     Finest relative precision and its inverse.
00313 *       RTOVFL, RTUNFL  Square roots of the previous 2 values.
00314 *               The following four arrays decode JTYPE:
00315 *       KTYPE(j)        The general type (1-10) for type "j".
00316 *       KMODE(j)        The MODE value to be passed to the matrix
00317 *                       generator for type "j".
00318 *       KMAGN(j)        The order of magnitude ( O(1),
00319 *                       O(overflow^(1/2) ), O(underflow^(1/2) )
00320 *
00321 *     The tests performed are:                 Routine tested
00322 *    1= | A - U S U' | / ( |A| n ulp )         DSTEV('V', ... )
00323 *    2= | I - U U' | / ( n ulp )               DSTEV('V', ... )
00324 *    3= |D(with Z) - D(w/o Z)| / (|D| ulp)     DSTEV('N', ... )
00325 *    4= | A - U S U' | / ( |A| n ulp )         DSTEVX('V','A', ... )
00326 *    5= | I - U U' | / ( n ulp )               DSTEVX('V','A', ... )
00327 *    6= |D(with Z) - EVEIGS| / (|D| ulp)       DSTEVX('N','A', ... )
00328 *    7= | A - U S U' | / ( |A| n ulp )         DSTEVR('V','A', ... )
00329 *    8= | I - U U' | / ( n ulp )               DSTEVR('V','A', ... )
00330 *    9= |D(with Z) - EVEIGS| / (|D| ulp)       DSTEVR('N','A', ... )
00331 *    10= | A - U S U' | / ( |A| n ulp )        DSTEVX('V','I', ... )
00332 *    11= | I - U U' | / ( n ulp )              DSTEVX('V','I', ... )
00333 *    12= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSTEVX('N','I', ... )
00334 *    13= | A - U S U' | / ( |A| n ulp )        DSTEVX('V','V', ... )
00335 *    14= | I - U U' | / ( n ulp )              DSTEVX('V','V', ... )
00336 *    15= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSTEVX('N','V', ... )
00337 *    16= | A - U S U' | / ( |A| n ulp )        DSTEVD('V', ... )
00338 *    17= | I - U U' | / ( n ulp )              DSTEVD('V', ... )
00339 *    18= |D(with Z) - EVEIGS| / (|D| ulp)      DSTEVD('N', ... )
00340 *    19= | A - U S U' | / ( |A| n ulp )        DSTEVR('V','I', ... )
00341 *    20= | I - U U' | / ( n ulp )              DSTEVR('V','I', ... )
00342 *    21= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSTEVR('N','I', ... )
00343 *    22= | A - U S U' | / ( |A| n ulp )        DSTEVR('V','V', ... )
00344 *    23= | I - U U' | / ( n ulp )              DSTEVR('V','V', ... )
00345 *    24= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSTEVR('N','V', ... )
00346 *
00347 *    25= | A - U S U' | / ( |A| n ulp )        DSYEV('L','V', ... )
00348 *    26= | I - U U' | / ( n ulp )              DSYEV('L','V', ... )
00349 *    27= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSYEV('L','N', ... )
00350 *    28= | A - U S U' | / ( |A| n ulp )        DSYEVX('L','V','A', ... )
00351 *    29= | I - U U' | / ( n ulp )              DSYEVX('L','V','A', ... )
00352 *    30= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSYEVX('L','N','A', ... )
00353 *    31= | A - U S U' | / ( |A| n ulp )        DSYEVX('L','V','I', ... )
00354 *    32= | I - U U' | / ( n ulp )              DSYEVX('L','V','I', ... )
00355 *    33= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSYEVX('L','N','I', ... )
00356 *    34= | A - U S U' | / ( |A| n ulp )        DSYEVX('L','V','V', ... )
00357 *    35= | I - U U' | / ( n ulp )              DSYEVX('L','V','V', ... )
00358 *    36= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSYEVX('L','N','V', ... )
00359 *    37= | A - U S U' | / ( |A| n ulp )        DSPEV('L','V', ... )
00360 *    38= | I - U U' | / ( n ulp )              DSPEV('L','V', ... )
00361 *    39= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSPEV('L','N', ... )
00362 *    40= | A - U S U' | / ( |A| n ulp )        DSPEVX('L','V','A', ... )
00363 *    41= | I - U U' | / ( n ulp )              DSPEVX('L','V','A', ... )
00364 *    42= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSPEVX('L','N','A', ... )
00365 *    43= | A - U S U' | / ( |A| n ulp )        DSPEVX('L','V','I', ... )
00366 *    44= | I - U U' | / ( n ulp )              DSPEVX('L','V','I', ... )
00367 *    45= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSPEVX('L','N','I', ... )
00368 *    46= | A - U S U' | / ( |A| n ulp )        DSPEVX('L','V','V', ... )
00369 *    47= | I - U U' | / ( n ulp )              DSPEVX('L','V','V', ... )
00370 *    48= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSPEVX('L','N','V', ... )
00371 *    49= | A - U S U' | / ( |A| n ulp )        DSBEV('L','V', ... )
00372 *    50= | I - U U' | / ( n ulp )              DSBEV('L','V', ... )
00373 *    51= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSBEV('L','N', ... )
00374 *    52= | A - U S U' | / ( |A| n ulp )        DSBEVX('L','V','A', ... )
00375 *    53= | I - U U' | / ( n ulp )              DSBEVX('L','V','A', ... )
00376 *    54= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSBEVX('L','N','A', ... )
00377 *    55= | A - U S U' | / ( |A| n ulp )        DSBEVX('L','V','I', ... )
00378 *    56= | I - U U' | / ( n ulp )              DSBEVX('L','V','I', ... )
00379 *    57= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSBEVX('L','N','I', ... )
00380 *    58= | A - U S U' | / ( |A| n ulp )        DSBEVX('L','V','V', ... )
00381 *    59= | I - U U' | / ( n ulp )              DSBEVX('L','V','V', ... )
00382 *    60= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSBEVX('L','N','V', ... )
00383 *    61= | A - U S U' | / ( |A| n ulp )        DSYEVD('L','V', ... )
00384 *    62= | I - U U' | / ( n ulp )              DSYEVD('L','V', ... )
00385 *    63= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSYEVD('L','N', ... )
00386 *    64= | A - U S U' | / ( |A| n ulp )        DSPEVD('L','V', ... )
00387 *    65= | I - U U' | / ( n ulp )              DSPEVD('L','V', ... )
00388 *    66= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSPEVD('L','N', ... )
00389 *    67= | A - U S U' | / ( |A| n ulp )        DSBEVD('L','V', ... )
00390 *    68= | I - U U' | / ( n ulp )              DSBEVD('L','V', ... )
00391 *    69= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSBEVD('L','N', ... )
00392 *    70= | A - U S U' | / ( |A| n ulp )        DSYEVR('L','V','A', ... )
00393 *    71= | I - U U' | / ( n ulp )              DSYEVR('L','V','A', ... )
00394 *    72= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSYEVR('L','N','A', ... )
00395 *    73= | A - U S U' | / ( |A| n ulp )        DSYEVR('L','V','I', ... )
00396 *    74= | I - U U' | / ( n ulp )              DSYEVR('L','V','I', ... )
00397 *    75= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSYEVR('L','N','I', ... )
00398 *    76= | A - U S U' | / ( |A| n ulp )        DSYEVR('L','V','V', ... )
00399 *    77= | I - U U' | / ( n ulp )              DSYEVR('L','V','V', ... )
00400 *    78= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSYEVR('L','N','V', ... )
00401 *
00402 *    Tests 25 through 78 are repeated (as tests 79 through 132)
00403 *    with UPLO='U'
00404 *
00405 *    To be added in 1999
00406 *
00407 *    79= | A - U S U' | / ( |A| n ulp )        DSPEVR('L','V','A', ... )
00408 *    80= | I - U U' | / ( n ulp )              DSPEVR('L','V','A', ... )
00409 *    81= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSPEVR('L','N','A', ... )
00410 *    82= | A - U S U' | / ( |A| n ulp )        DSPEVR('L','V','I', ... )
00411 *    83= | I - U U' | / ( n ulp )              DSPEVR('L','V','I', ... )
00412 *    84= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSPEVR('L','N','I', ... )
00413 *    85= | A - U S U' | / ( |A| n ulp )        DSPEVR('L','V','V', ... )
00414 *    86= | I - U U' | / ( n ulp )              DSPEVR('L','V','V', ... )
00415 *    87= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSPEVR('L','N','V', ... )
00416 *    88= | A - U S U' | / ( |A| n ulp )        DSBEVR('L','V','A', ... )
00417 *    89= | I - U U' | / ( n ulp )              DSBEVR('L','V','A', ... )
00418 *    90= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSBEVR('L','N','A', ... )
00419 *    91= | A - U S U' | / ( |A| n ulp )        DSBEVR('L','V','I', ... )
00420 *    92= | I - U U' | / ( n ulp )              DSBEVR('L','V','I', ... )
00421 *    93= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSBEVR('L','N','I', ... )
00422 *    94= | A - U S U' | / ( |A| n ulp )        DSBEVR('L','V','V', ... )
00423 *    95= | I - U U' | / ( n ulp )              DSBEVR('L','V','V', ... )
00424 *    96= |D(with Z) - D(w/o Z)| / (|D| ulp)    DSBEVR('L','N','V', ... )
00425 *
00426 *
00427 *  =====================================================================
00428 *
00429 *     .. Parameters ..
00430       DOUBLE PRECISION   ZERO, ONE, TWO, TEN
00431       PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0,
00432      $                   TEN = 10.0D0 )
00433       DOUBLE PRECISION   HALF
00434       PARAMETER          ( HALF = 0.5D0 )
00435       INTEGER            MAXTYP
00436       PARAMETER          ( MAXTYP = 18 )
00437 *     ..
00438 *     .. Local Scalars ..
00439       LOGICAL            BADNN
00440       CHARACTER          UPLO
00441       INTEGER            I, IDIAG, IHBW, IINFO, IL, IMODE, INDX, IROW,
00442      $                   ITEMP, ITYPE, IU, IUPLO, J, J1, J2, JCOL,
00443      $                   JSIZE, JTYPE, KD, LGN, LIWEDC, LWEDC, M, M2,
00444      $                   M3, MTYPES, N, NERRS, NMATS, NMAX, NTEST,
00445      $                   NTESTT
00446       DOUBLE PRECISION   ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
00447      $                   RTUNFL, TEMP1, TEMP2, TEMP3, ULP, ULPINV, UNFL,
00448      $                   VL, VU
00449 *     ..
00450 *     .. Local Arrays ..
00451       INTEGER            IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
00452      $                   ISEED3( 4 ), KMAGN( MAXTYP ), KMODE( MAXTYP ),
00453      $                   KTYPE( MAXTYP )
00454 *     ..
00455 *     .. External Functions ..
00456       DOUBLE PRECISION   DLAMCH, DLARND, DSXT1
00457       EXTERNAL           DLAMCH, DLARND, DSXT1
00458 *     ..
00459 *     .. External Subroutines ..
00460       EXTERNAL           ALASVM, DLABAD, DLACPY, DLAFTS, DLASET, DLATMR,
00461      $                   DLATMS, DSBEV, DSBEVD, DSBEVX, DSPEV, DSPEVD,
00462      $                   DSPEVX, DSTEV, DSTEVD, DSTEVR, DSTEVX, DSTT21,
00463      $                   DSTT22, DSYEV, DSYEVD, DSYEVR, DSYEVX, DSYT21,
00464      $                   DSYT22, XERBLA
00465 *     ..
00466 *     .. Scalars in Common ..
00467       CHARACTER*32       SRNAMT
00468 *     ..
00469 *     .. Common blocks ..
00470       COMMON             / SRNAMC / SRNAMT
00471 *     ..
00472 *     .. Intrinsic Functions ..
00473       INTRINSIC          ABS, DBLE, INT, LOG, MAX, MIN, SQRT
00474 *     ..
00475 *     .. Data statements ..
00476       DATA               KTYPE / 1, 2, 5*4, 5*5, 3*8, 3*9 /
00477       DATA               KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
00478      $                   2, 3, 1, 2, 3 /
00479       DATA               KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
00480      $                   0, 0, 4, 4, 4 /
00481 *     ..
00482 *     .. Executable Statements ..
00483 *
00484 *     Keep ftrnchek happy
00485 *
00486       VL = ZERO
00487       VU = ZERO
00488 *
00489 *     1)      Check for errors
00490 *
00491       NTESTT = 0
00492       INFO = 0
00493 *
00494       BADNN = .FALSE.
00495       NMAX = 1
00496       DO 10 J = 1, NSIZES
00497          NMAX = MAX( NMAX, NN( J ) )
00498          IF( NN( J ).LT.0 )
00499      $      BADNN = .TRUE.
00500    10 CONTINUE
00501 *
00502 *     Check for errors
00503 *
00504       IF( NSIZES.LT.0 ) THEN
00505          INFO = -1
00506       ELSE IF( BADNN ) THEN
00507          INFO = -2
00508       ELSE IF( NTYPES.LT.0 ) THEN
00509          INFO = -3
00510       ELSE IF( LDA.LT.NMAX ) THEN
00511          INFO = -9
00512       ELSE IF( LDU.LT.NMAX ) THEN
00513          INFO = -16
00514       ELSE IF( 2*MAX( 2, NMAX )**2.GT.LWORK ) THEN
00515          INFO = -21
00516       END IF
00517 *
00518       IF( INFO.NE.0 ) THEN
00519          CALL XERBLA( 'DDRVST', -INFO )
00520          RETURN
00521       END IF
00522 *
00523 *     Quick return if nothing to do
00524 *
00525       IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 )
00526      $   RETURN
00527 *
00528 *     More Important constants
00529 *
00530       UNFL = DLAMCH( 'Safe minimum' )
00531       OVFL = DLAMCH( 'Overflow' )
00532       CALL DLABAD( UNFL, OVFL )
00533       ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' )
00534       ULPINV = ONE / ULP
00535       RTUNFL = SQRT( UNFL )
00536       RTOVFL = SQRT( OVFL )
00537 *
00538 *     Loop over sizes, types
00539 *
00540       DO 20 I = 1, 4
00541          ISEED2( I ) = ISEED( I )
00542          ISEED3( I ) = ISEED( I )
00543    20 CONTINUE
00544 *
00545       NERRS = 0
00546       NMATS = 0
00547 *
00548 *
00549       DO 1740 JSIZE = 1, NSIZES
00550          N = NN( JSIZE )
00551          IF( N.GT.0 ) THEN
00552             LGN = INT( LOG( DBLE( N ) ) / LOG( TWO ) )
00553             IF( 2**LGN.LT.N )
00554      $         LGN = LGN + 1
00555             IF( 2**LGN.LT.N )
00556      $         LGN = LGN + 1
00557             LWEDC = 1 + 4*N + 2*N*LGN + 4*N**2
00558 c           LIWEDC = 6 + 6*N + 5*N*LGN
00559             LIWEDC = 3 + 5*N
00560          ELSE
00561             LWEDC = 9
00562 c           LIWEDC = 12
00563             LIWEDC = 8
00564          END IF
00565          ANINV = ONE / DBLE( MAX( 1, N ) )
00566 *
00567          IF( NSIZES.NE.1 ) THEN
00568             MTYPES = MIN( MAXTYP, NTYPES )
00569          ELSE
00570             MTYPES = MIN( MAXTYP+1, NTYPES )
00571          END IF
00572 *
00573          DO 1730 JTYPE = 1, MTYPES
00574 *
00575             IF( .NOT.DOTYPE( JTYPE ) )
00576      $         GO TO 1730
00577             NMATS = NMATS + 1
00578             NTEST = 0
00579 *
00580             DO 30 J = 1, 4
00581                IOLDSD( J ) = ISEED( J )
00582    30       CONTINUE
00583 *
00584 *           2)      Compute "A"
00585 *
00586 *                   Control parameters:
00587 *
00588 *               KMAGN  KMODE        KTYPE
00589 *           =1  O(1)   clustered 1  zero
00590 *           =2  large  clustered 2  identity
00591 *           =3  small  exponential  (none)
00592 *           =4         arithmetic   diagonal, (w/ eigenvalues)
00593 *           =5         random log   symmetric, w/ eigenvalues
00594 *           =6         random       (none)
00595 *           =7                      random diagonal
00596 *           =8                      random symmetric
00597 *           =9                      band symmetric, w/ eigenvalues
00598 *
00599             IF( MTYPES.GT.MAXTYP )
00600      $         GO TO 110
00601 *
00602             ITYPE = KTYPE( JTYPE )
00603             IMODE = KMODE( JTYPE )
00604 *
00605 *           Compute norm
00606 *
00607             GO TO ( 40, 50, 60 )KMAGN( JTYPE )
00608 *
00609    40       CONTINUE
00610             ANORM = ONE
00611             GO TO 70
00612 *
00613    50       CONTINUE
00614             ANORM = ( RTOVFL*ULP )*ANINV
00615             GO TO 70
00616 *
00617    60       CONTINUE
00618             ANORM = RTUNFL*N*ULPINV
00619             GO TO 70
00620 *
00621    70       CONTINUE
00622 *
00623             CALL DLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA )
00624             IINFO = 0
00625             COND = ULPINV
00626 *
00627 *           Special Matrices -- Identity & Jordan block
00628 *
00629 *                   Zero
00630 *
00631             IF( ITYPE.EQ.1 ) THEN
00632                IINFO = 0
00633 *
00634             ELSE IF( ITYPE.EQ.2 ) THEN
00635 *
00636 *              Identity
00637 *
00638                DO 80 JCOL = 1, N
00639                   A( JCOL, JCOL ) = ANORM
00640    80          CONTINUE
00641 *
00642             ELSE IF( ITYPE.EQ.4 ) THEN
00643 *
00644 *              Diagonal Matrix, [Eigen]values Specified
00645 *
00646                CALL DLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
00647      $                      ANORM, 0, 0, 'N', A, LDA, WORK( N+1 ),
00648      $                      IINFO )
00649 *
00650             ELSE IF( ITYPE.EQ.5 ) THEN
00651 *
00652 *              Symmetric, eigenvalues specified
00653 *
00654                CALL DLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
00655      $                      ANORM, N, N, 'N', A, LDA, WORK( N+1 ),
00656      $                      IINFO )
00657 *
00658             ELSE IF( ITYPE.EQ.7 ) THEN
00659 *
00660 *              Diagonal, random eigenvalues
00661 *
00662                IDUMMA( 1 ) = 1
00663                CALL DLATMR( N, N, 'S', ISEED, 'S', WORK, 6, ONE, ONE,
00664      $                      'T', 'N', WORK( N+1 ), 1, ONE,
00665      $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
00666      $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
00667 *
00668             ELSE IF( ITYPE.EQ.8 ) THEN
00669 *
00670 *              Symmetric, random eigenvalues
00671 *
00672                IDUMMA( 1 ) = 1
00673                CALL DLATMR( N, N, 'S', ISEED, 'S', WORK, 6, ONE, ONE,
00674      $                      'T', 'N', WORK( N+1 ), 1, ONE,
00675      $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N,
00676      $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
00677 *
00678             ELSE IF( ITYPE.EQ.9 ) THEN
00679 *
00680 *              Symmetric banded, eigenvalues specified
00681 *
00682                IHBW = INT( ( N-1 )*DLARND( 1, ISEED3 ) )
00683                CALL DLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
00684      $                      ANORM, IHBW, IHBW, 'Z', U, LDU, WORK( N+1 ),
00685      $                      IINFO )
00686 *
00687 *              Store as dense matrix for most routines.
00688 *
00689                CALL DLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA )
00690                DO 100 IDIAG = -IHBW, IHBW
00691                   IROW = IHBW - IDIAG + 1
00692                   J1 = MAX( 1, IDIAG+1 )
00693                   J2 = MIN( N, N+IDIAG )
00694                   DO 90 J = J1, J2
00695                      I = J - IDIAG
00696                      A( I, J ) = U( IROW, J )
00697    90             CONTINUE
00698   100          CONTINUE
00699             ELSE
00700                IINFO = 1
00701             END IF
00702 *
00703             IF( IINFO.NE.0 ) THEN
00704                WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE,
00705      $            IOLDSD
00706                INFO = ABS( IINFO )
00707                RETURN
00708             END IF
00709 *
00710   110       CONTINUE
00711 *
00712             ABSTOL = UNFL + UNFL
00713             IF( N.LE.1 ) THEN
00714                IL = 1
00715                IU = N
00716             ELSE
00717                IL = 1 + ( N-1 )*INT( DLARND( 1, ISEED2 ) )
00718                IU = 1 + ( N-1 )*INT( DLARND( 1, ISEED2 ) )
00719                IF( IL.GT.IU ) THEN
00720                   ITEMP = IL
00721                   IL = IU
00722                   IU = ITEMP
00723                END IF
00724             END IF
00725 *
00726 *           3)      If matrix is tridiagonal, call DSTEV and DSTEVX.
00727 *
00728             IF( JTYPE.LE.7 ) THEN
00729                NTEST = 1
00730                DO 120 I = 1, N
00731                   D1( I ) = DBLE( A( I, I ) )
00732   120          CONTINUE
00733                DO 130 I = 1, N - 1
00734                   D2( I ) = DBLE( A( I+1, I ) )
00735   130          CONTINUE
00736                SRNAMT = 'DSTEV'
00737                CALL DSTEV( 'V', N, D1, D2, Z, LDU, WORK, IINFO )
00738                IF( IINFO.NE.0 ) THEN
00739                   WRITE( NOUNIT, FMT = 9999 )'DSTEV(V)', IINFO, N,
00740      $               JTYPE, IOLDSD
00741                   INFO = ABS( IINFO )
00742                   IF( IINFO.LT.0 ) THEN
00743                      RETURN
00744                   ELSE
00745                      RESULT( 1 ) = ULPINV
00746                      RESULT( 2 ) = ULPINV
00747                      RESULT( 3 ) = ULPINV
00748                      GO TO 180
00749                   END IF
00750                END IF
00751 *
00752 *              Do tests 1 and 2.
00753 *
00754                DO 140 I = 1, N
00755                   D3( I ) = DBLE( A( I, I ) )
00756   140          CONTINUE
00757                DO 150 I = 1, N - 1
00758                   D4( I ) = DBLE( A( I+1, I ) )
00759   150          CONTINUE
00760                CALL DSTT21( N, 0, D3, D4, D1, D2, Z, LDU, WORK,
00761      $                      RESULT( 1 ) )
00762 *
00763                NTEST = 3
00764                DO 160 I = 1, N - 1
00765                   D4( I ) = DBLE( A( I+1, I ) )
00766   160          CONTINUE
00767                SRNAMT = 'DSTEV'
00768                CALL DSTEV( 'N', N, D3, D4, Z, LDU, WORK, IINFO )
00769                IF( IINFO.NE.0 ) THEN
00770                   WRITE( NOUNIT, FMT = 9999 )'DSTEV(N)', IINFO, N,
00771      $               JTYPE, IOLDSD
00772                   INFO = ABS( IINFO )
00773                   IF( IINFO.LT.0 ) THEN
00774                      RETURN
00775                   ELSE
00776                      RESULT( 3 ) = ULPINV
00777                      GO TO 180
00778                   END IF
00779                END IF
00780 *
00781 *              Do test 3.
00782 *
00783                TEMP1 = ZERO
00784                TEMP2 = ZERO
00785                DO 170 J = 1, N
00786                   TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
00787                   TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
00788   170          CONTINUE
00789                RESULT( 3 ) = TEMP2 / MAX( UNFL,
00790      $                       ULP*MAX( TEMP1, TEMP2 ) )
00791 *
00792   180          CONTINUE
00793 *
00794                NTEST = 4
00795                DO 190 I = 1, N
00796                   EVEIGS( I ) = D3( I )
00797                   D1( I ) = DBLE( A( I, I ) )
00798   190          CONTINUE
00799                DO 200 I = 1, N - 1
00800                   D2( I ) = DBLE( A( I+1, I ) )
00801   200          CONTINUE
00802                SRNAMT = 'DSTEVX'
00803                CALL DSTEVX( 'V', 'A', N, D1, D2, VL, VU, IL, IU, ABSTOL,
00804      $                      M, WA1, Z, LDU, WORK, IWORK, IWORK( 5*N+1 ),
00805      $                      IINFO )
00806                IF( IINFO.NE.0 ) THEN
00807                   WRITE( NOUNIT, FMT = 9999 )'DSTEVX(V,A)', IINFO, N,
00808      $               JTYPE, IOLDSD
00809                   INFO = ABS( IINFO )
00810                   IF( IINFO.LT.0 ) THEN
00811                      RETURN
00812                   ELSE
00813                      RESULT( 4 ) = ULPINV
00814                      RESULT( 5 ) = ULPINV
00815                      RESULT( 6 ) = ULPINV
00816                      GO TO 250
00817                   END IF
00818                END IF
00819                IF( N.GT.0 ) THEN
00820                   TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
00821                ELSE
00822                   TEMP3 = ZERO
00823                END IF
00824 *
00825 *              Do tests 4 and 5.
00826 *
00827                DO 210 I = 1, N
00828                   D3( I ) = DBLE( A( I, I ) )
00829   210          CONTINUE
00830                DO 220 I = 1, N - 1
00831                   D4( I ) = DBLE( A( I+1, I ) )
00832   220          CONTINUE
00833                CALL DSTT21( N, 0, D3, D4, WA1, D2, Z, LDU, WORK,
00834      $                      RESULT( 4 ) )
00835 *
00836                NTEST = 6
00837                DO 230 I = 1, N - 1
00838                   D4( I ) = DBLE( A( I+1, I ) )
00839   230          CONTINUE
00840                SRNAMT = 'DSTEVX'
00841                CALL DSTEVX( 'N', 'A', N, D3, D4, VL, VU, IL, IU, ABSTOL,
00842      $                      M2, WA2, Z, LDU, WORK, IWORK,
00843      $                      IWORK( 5*N+1 ), IINFO )
00844                IF( IINFO.NE.0 ) THEN
00845                   WRITE( NOUNIT, FMT = 9999 )'DSTEVX(N,A)', IINFO, N,
00846      $               JTYPE, IOLDSD
00847                   INFO = ABS( IINFO )
00848                   IF( IINFO.LT.0 ) THEN
00849                      RETURN
00850                   ELSE
00851                      RESULT( 6 ) = ULPINV
00852                      GO TO 250
00853                   END IF
00854                END IF
00855 *
00856 *              Do test 6.
00857 *
00858                TEMP1 = ZERO
00859                TEMP2 = ZERO
00860                DO 240 J = 1, N
00861                   TEMP1 = MAX( TEMP1, ABS( WA2( J ) ),
00862      $                    ABS( EVEIGS( J ) ) )
00863                   TEMP2 = MAX( TEMP2, ABS( WA2( J )-EVEIGS( J ) ) )
00864   240          CONTINUE
00865                RESULT( 6 ) = TEMP2 / MAX( UNFL,
00866      $                       ULP*MAX( TEMP1, TEMP2 ) )
00867 *
00868   250          CONTINUE
00869 *
00870                NTEST = 7
00871                DO 260 I = 1, N
00872                   D1( I ) = DBLE( A( I, I ) )
00873   260          CONTINUE
00874                DO 270 I = 1, N - 1
00875                   D2( I ) = DBLE( A( I+1, I ) )
00876   270          CONTINUE
00877                SRNAMT = 'DSTEVR'
00878                CALL DSTEVR( 'V', 'A', N, D1, D2, VL, VU, IL, IU, ABSTOL,
00879      $                      M, WA1, Z, LDU, IWORK, WORK, LWORK,
00880      $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
00881                IF( IINFO.NE.0 ) THEN
00882                   WRITE( NOUNIT, FMT = 9999 )'DSTEVR(V,A)', IINFO, N,
00883      $               JTYPE, IOLDSD
00884                   INFO = ABS( IINFO )
00885                   IF( IINFO.LT.0 ) THEN
00886                      RETURN
00887                   ELSE
00888                      RESULT( 7 ) = ULPINV
00889                      RESULT( 8 ) = ULPINV
00890                      GO TO 320
00891                   END IF
00892                END IF
00893                IF( N.GT.0 ) THEN
00894                   TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
00895                ELSE
00896                   TEMP3 = ZERO
00897                END IF
00898 *
00899 *              Do tests 7 and 8.
00900 *
00901                DO 280 I = 1, N
00902                   D3( I ) = DBLE( A( I, I ) )
00903   280          CONTINUE
00904                DO 290 I = 1, N - 1
00905                   D4( I ) = DBLE( A( I+1, I ) )
00906   290          CONTINUE
00907                CALL DSTT21( N, 0, D3, D4, WA1, D2, Z, LDU, WORK,
00908      $                      RESULT( 7 ) )
00909 *
00910                NTEST = 9
00911                DO 300 I = 1, N - 1
00912                   D4( I ) = DBLE( A( I+1, I ) )
00913   300          CONTINUE
00914                SRNAMT = 'DSTEVR'
00915                CALL DSTEVR( 'N', 'A', N, D3, D4, VL, VU, IL, IU, ABSTOL,
00916      $                      M2, WA2, Z, LDU, IWORK, WORK, LWORK,
00917      $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
00918                IF( IINFO.NE.0 ) THEN
00919                   WRITE( NOUNIT, FMT = 9999 )'DSTEVR(N,A)', IINFO, N,
00920      $               JTYPE, IOLDSD
00921                   INFO = ABS( IINFO )
00922                   IF( IINFO.LT.0 ) THEN
00923                      RETURN
00924                   ELSE
00925                      RESULT( 9 ) = ULPINV
00926                      GO TO 320
00927                   END IF
00928                END IF
00929 *
00930 *              Do test 9.
00931 *
00932                TEMP1 = ZERO
00933                TEMP2 = ZERO
00934                DO 310 J = 1, N
00935                   TEMP1 = MAX( TEMP1, ABS( WA2( J ) ),
00936      $                    ABS( EVEIGS( J ) ) )
00937                   TEMP2 = MAX( TEMP2, ABS( WA2( J )-EVEIGS( J ) ) )
00938   310          CONTINUE
00939                RESULT( 9 ) = TEMP2 / MAX( UNFL,
00940      $                       ULP*MAX( TEMP1, TEMP2 ) )
00941 *
00942   320          CONTINUE
00943 *
00944 *
00945                NTEST = 10
00946                DO 330 I = 1, N
00947                   D1( I ) = DBLE( A( I, I ) )
00948   330          CONTINUE
00949                DO 340 I = 1, N - 1
00950                   D2( I ) = DBLE( A( I+1, I ) )
00951   340          CONTINUE
00952                SRNAMT = 'DSTEVX'
00953                CALL DSTEVX( 'V', 'I', N, D1, D2, VL, VU, IL, IU, ABSTOL,
00954      $                      M2, WA2, Z, LDU, WORK, IWORK,
00955      $                      IWORK( 5*N+1 ), IINFO )
00956                IF( IINFO.NE.0 ) THEN
00957                   WRITE( NOUNIT, FMT = 9999 )'DSTEVX(V,I)', IINFO, N,
00958      $               JTYPE, IOLDSD
00959                   INFO = ABS( IINFO )
00960                   IF( IINFO.LT.0 ) THEN
00961                      RETURN
00962                   ELSE
00963                      RESULT( 10 ) = ULPINV
00964                      RESULT( 11 ) = ULPINV
00965                      RESULT( 12 ) = ULPINV
00966                      GO TO 380
00967                   END IF
00968                END IF
00969 *
00970 *              Do tests 10 and 11.
00971 *
00972                DO 350 I = 1, N
00973                   D3( I ) = DBLE( A( I, I ) )
00974   350          CONTINUE
00975                DO 360 I = 1, N - 1
00976                   D4( I ) = DBLE( A( I+1, I ) )
00977   360          CONTINUE
00978                CALL DSTT22( N, M2, 0, D3, D4, WA2, D2, Z, LDU, WORK,
00979      $                      MAX( 1, M2 ), RESULT( 10 ) )
00980 *
00981 *
00982                NTEST = 12
00983                DO 370 I = 1, N - 1
00984                   D4( I ) = DBLE( A( I+1, I ) )
00985   370          CONTINUE
00986                SRNAMT = 'DSTEVX'
00987                CALL DSTEVX( 'N', 'I', N, D3, D4, VL, VU, IL, IU, ABSTOL,
00988      $                      M3, WA3, Z, LDU, WORK, IWORK,
00989      $                      IWORK( 5*N+1 ), IINFO )
00990                IF( IINFO.NE.0 ) THEN
00991                   WRITE( NOUNIT, FMT = 9999 )'DSTEVX(N,I)', IINFO, N,
00992      $               JTYPE, IOLDSD
00993                   INFO = ABS( IINFO )
00994                   IF( IINFO.LT.0 ) THEN
00995                      RETURN
00996                   ELSE
00997                      RESULT( 12 ) = ULPINV
00998                      GO TO 380
00999                   END IF
01000                END IF
01001 *
01002 *              Do test 12.
01003 *
01004                TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
01005                TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
01006                RESULT( 12 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, ULP*TEMP3 )
01007 *
01008   380          CONTINUE
01009 *
01010                NTEST = 12
01011                IF( N.GT.0 ) THEN
01012                   IF( IL.NE.1 ) THEN
01013                      VL = WA1( IL ) - MAX( HALF*
01014      $                    ( WA1( IL )-WA1( IL-1 ) ), TEN*ULP*TEMP3,
01015      $                    TEN*RTUNFL )
01016                   ELSE
01017                      VL = WA1( 1 ) - MAX( HALF*( WA1( N )-WA1( 1 ) ),
01018      $                    TEN*ULP*TEMP3, TEN*RTUNFL )
01019                   END IF
01020                   IF( IU.NE.N ) THEN
01021                      VU = WA1( IU ) + MAX( HALF*
01022      $                    ( WA1( IU+1 )-WA1( IU ) ), TEN*ULP*TEMP3,
01023      $                    TEN*RTUNFL )
01024                   ELSE
01025                      VU = WA1( N ) + MAX( HALF*( WA1( N )-WA1( 1 ) ),
01026      $                    TEN*ULP*TEMP3, TEN*RTUNFL )
01027                   END IF
01028                ELSE
01029                   VL = ZERO
01030                   VU = ONE
01031                END IF
01032 *
01033                DO 390 I = 1, N
01034                   D1( I ) = DBLE( A( I, I ) )
01035   390          CONTINUE
01036                DO 400 I = 1, N - 1
01037                   D2( I ) = DBLE( A( I+1, I ) )
01038   400          CONTINUE
01039                SRNAMT = 'DSTEVX'
01040                CALL DSTEVX( 'V', 'V', N, D1, D2, VL, VU, IL, IU, ABSTOL,
01041      $                      M2, WA2, Z, LDU, WORK, IWORK,
01042      $                      IWORK( 5*N+1 ), IINFO )
01043                IF( IINFO.NE.0 ) THEN
01044                   WRITE( NOUNIT, FMT = 9999 )'DSTEVX(V,V)', IINFO, N,
01045      $               JTYPE, IOLDSD
01046                   INFO = ABS( IINFO )
01047                   IF( IINFO.LT.0 ) THEN
01048                      RETURN
01049                   ELSE
01050                      RESULT( 13 ) = ULPINV
01051                      RESULT( 14 ) = ULPINV
01052                      RESULT( 15 ) = ULPINV
01053                      GO TO 440
01054                   END IF
01055                END IF
01056 *
01057                IF( M2.EQ.0 .AND. N.GT.0 ) THEN
01058                   RESULT( 13 ) = ULPINV
01059                   RESULT( 14 ) = ULPINV
01060                   RESULT( 15 ) = ULPINV
01061                   GO TO 440
01062                END IF
01063 *
01064 *              Do tests 13 and 14.
01065 *
01066                DO 410 I = 1, N
01067                   D3( I ) = DBLE( A( I, I ) )
01068   410          CONTINUE
01069                DO 420 I = 1, N - 1
01070                   D4( I ) = DBLE( A( I+1, I ) )
01071   420          CONTINUE
01072                CALL DSTT22( N, M2, 0, D3, D4, WA2, D2, Z, LDU, WORK,
01073      $                      MAX( 1, M2 ), RESULT( 13 ) )
01074 *
01075                NTEST = 15
01076                DO 430 I = 1, N - 1
01077                   D4( I ) = DBLE( A( I+1, I ) )
01078   430          CONTINUE
01079                SRNAMT = 'DSTEVX'
01080                CALL DSTEVX( 'N', 'V', N, D3, D4, VL, VU, IL, IU, ABSTOL,
01081      $                      M3, WA3, Z, LDU, WORK, IWORK,
01082      $                      IWORK( 5*N+1 ), IINFO )
01083                IF( IINFO.NE.0 ) THEN
01084                   WRITE( NOUNIT, FMT = 9999 )'DSTEVX(N,V)', IINFO, N,
01085      $               JTYPE, IOLDSD
01086                   INFO = ABS( IINFO )
01087                   IF( IINFO.LT.0 ) THEN
01088                      RETURN
01089                   ELSE
01090                      RESULT( 15 ) = ULPINV
01091                      GO TO 440
01092                   END IF
01093                END IF
01094 *
01095 *              Do test 15.
01096 *
01097                TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
01098                TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
01099                RESULT( 15 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, TEMP3*ULP )
01100 *
01101   440          CONTINUE
01102 *
01103                NTEST = 16
01104                DO 450 I = 1, N
01105                   D1( I ) = DBLE( A( I, I ) )
01106   450          CONTINUE
01107                DO 460 I = 1, N - 1
01108                   D2( I ) = DBLE( A( I+1, I ) )
01109   460          CONTINUE
01110                SRNAMT = 'DSTEVD'
01111                CALL DSTEVD( 'V', N, D1, D2, Z, LDU, WORK, LWEDC, IWORK,
01112      $                      LIWEDC, IINFO )
01113                IF( IINFO.NE.0 ) THEN
01114                   WRITE( NOUNIT, FMT = 9999 )'DSTEVD(V)', IINFO, N,
01115      $               JTYPE, IOLDSD
01116                   INFO = ABS( IINFO )
01117                   IF( IINFO.LT.0 ) THEN
01118                      RETURN
01119                   ELSE
01120                      RESULT( 16 ) = ULPINV
01121                      RESULT( 17 ) = ULPINV
01122                      RESULT( 18 ) = ULPINV
01123                      GO TO 510
01124                   END IF
01125                END IF
01126 *
01127 *              Do tests 16 and 17.
01128 *
01129                DO 470 I = 1, N
01130                   D3( I ) = DBLE( A( I, I ) )
01131   470          CONTINUE
01132                DO 480 I = 1, N - 1
01133                   D4( I ) = DBLE( A( I+1, I ) )
01134   480          CONTINUE
01135                CALL DSTT21( N, 0, D3, D4, D1, D2, Z, LDU, WORK,
01136      $                      RESULT( 16 ) )
01137 *
01138                NTEST = 18
01139                DO 490 I = 1, N - 1
01140                   D4( I ) = DBLE( A( I+1, I ) )
01141   490          CONTINUE
01142                SRNAMT = 'DSTEVD'
01143                CALL DSTEVD( 'N', N, D3, D4, Z, LDU, WORK, LWEDC, IWORK,
01144      $                      LIWEDC, IINFO )
01145                IF( IINFO.NE.0 ) THEN
01146                   WRITE( NOUNIT, FMT = 9999 )'DSTEVD(N)', IINFO, N,
01147      $               JTYPE, IOLDSD
01148                   INFO = ABS( IINFO )
01149                   IF( IINFO.LT.0 ) THEN
01150                      RETURN
01151                   ELSE
01152                      RESULT( 18 ) = ULPINV
01153                      GO TO 510
01154                   END IF
01155                END IF
01156 *
01157 *              Do test 18.
01158 *
01159                TEMP1 = ZERO
01160                TEMP2 = ZERO
01161                DO 500 J = 1, N
01162                   TEMP1 = MAX( TEMP1, ABS( EVEIGS( J ) ),
01163      $                    ABS( D3( J ) ) )
01164                   TEMP2 = MAX( TEMP2, ABS( EVEIGS( J )-D3( J ) ) )
01165   500          CONTINUE
01166                RESULT( 18 ) = TEMP2 / MAX( UNFL,
01167      $                        ULP*MAX( TEMP1, TEMP2 ) )
01168 *
01169   510          CONTINUE
01170 *
01171                NTEST = 19
01172                DO 520 I = 1, N
01173                   D1( I ) = DBLE( A( I, I ) )
01174   520          CONTINUE
01175                DO 530 I = 1, N - 1
01176                   D2( I ) = DBLE( A( I+1, I ) )
01177   530          CONTINUE
01178                SRNAMT = 'DSTEVR'
01179                CALL DSTEVR( 'V', 'I', N, D1, D2, VL, VU, IL, IU, ABSTOL,
01180      $                      M2, WA2, Z, LDU, IWORK, WORK, LWORK,
01181      $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
01182                IF( IINFO.NE.0 ) THEN
01183                   WRITE( NOUNIT, FMT = 9999 )'DSTEVR(V,I)', IINFO, N,
01184      $               JTYPE, IOLDSD
01185                   INFO = ABS( IINFO )
01186                   IF( IINFO.LT.0 ) THEN
01187                      RETURN
01188                   ELSE
01189                      RESULT( 19 ) = ULPINV
01190                      RESULT( 20 ) = ULPINV
01191                      RESULT( 21 ) = ULPINV
01192                      GO TO 570
01193                   END IF
01194                END IF
01195 *
01196 *              DO tests 19 and 20.
01197 *
01198                DO 540 I = 1, N
01199                   D3( I ) = DBLE( A( I, I ) )
01200   540          CONTINUE
01201                DO 550 I = 1, N - 1
01202                   D4( I ) = DBLE( A( I+1, I ) )
01203   550          CONTINUE
01204                CALL DSTT22( N, M2, 0, D3, D4, WA2, D2, Z, LDU, WORK,
01205      $                      MAX( 1, M2 ), RESULT( 19 ) )
01206 *
01207 *
01208                NTEST = 21
01209                DO 560 I = 1, N - 1
01210                   D4( I ) = DBLE( A( I+1, I ) )
01211   560          CONTINUE
01212                SRNAMT = 'DSTEVR'
01213                CALL DSTEVR( 'N', 'I', N, D3, D4, VL, VU, IL, IU, ABSTOL,
01214      $                      M3, WA3, Z, LDU, IWORK, WORK, LWORK,
01215      $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
01216                IF( IINFO.NE.0 ) THEN
01217                   WRITE( NOUNIT, FMT = 9999 )'DSTEVR(N,I)', IINFO, N,
01218      $               JTYPE, IOLDSD
01219                   INFO = ABS( IINFO )
01220                   IF( IINFO.LT.0 ) THEN
01221                      RETURN
01222                   ELSE
01223                      RESULT( 21 ) = ULPINV
01224                      GO TO 570
01225                   END IF
01226                END IF
01227 *
01228 *              Do test 21.
01229 *
01230                TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
01231                TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
01232                RESULT( 21 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, ULP*TEMP3 )
01233 *
01234   570          CONTINUE
01235 *
01236                NTEST = 21
01237                IF( N.GT.0 ) THEN
01238                   IF( IL.NE.1 ) THEN
01239                      VL = WA1( IL ) - MAX( HALF*
01240      $                    ( WA1( IL )-WA1( IL-1 ) ), TEN*ULP*TEMP3,
01241      $                    TEN*RTUNFL )
01242                   ELSE
01243                      VL = WA1( 1 ) - MAX( HALF*( WA1( N )-WA1( 1 ) ),
01244      $                    TEN*ULP*TEMP3, TEN*RTUNFL )
01245                   END IF
01246                   IF( IU.NE.N ) THEN
01247                      VU = WA1( IU ) + MAX( HALF*
01248      $                    ( WA1( IU+1 )-WA1( IU ) ), TEN*ULP*TEMP3,
01249      $                    TEN*RTUNFL )
01250                   ELSE
01251                      VU = WA1( N ) + MAX( HALF*( WA1( N )-WA1( 1 ) ),
01252      $                    TEN*ULP*TEMP3, TEN*RTUNFL )
01253                   END IF
01254                ELSE
01255                   VL = ZERO
01256                   VU = ONE
01257                END IF
01258 *
01259                DO 580 I = 1, N
01260                   D1( I ) = DBLE( A( I, I ) )
01261   580          CONTINUE
01262                DO 590 I = 1, N - 1
01263                   D2( I ) = DBLE( A( I+1, I ) )
01264   590          CONTINUE
01265                SRNAMT = 'DSTEVR'
01266                CALL DSTEVR( 'V', 'V', N, D1, D2, VL, VU, IL, IU, ABSTOL,
01267      $                      M2, WA2, Z, LDU, IWORK, WORK, LWORK,
01268      $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
01269                IF( IINFO.NE.0 ) THEN
01270                   WRITE( NOUNIT, FMT = 9999 )'DSTEVR(V,V)', IINFO, N,
01271      $               JTYPE, IOLDSD
01272                   INFO = ABS( IINFO )
01273                   IF( IINFO.LT.0 ) THEN
01274                      RETURN
01275                   ELSE
01276                      RESULT( 22 ) = ULPINV
01277                      RESULT( 23 ) = ULPINV
01278                      RESULT( 24 ) = ULPINV
01279                      GO TO 630
01280                   END IF
01281                END IF
01282 *
01283                IF( M2.EQ.0 .AND. N.GT.0 ) THEN
01284                   RESULT( 22 ) = ULPINV
01285                   RESULT( 23 ) = ULPINV
01286                   RESULT( 24 ) = ULPINV
01287                   GO TO 630
01288                END IF
01289 *
01290 *              Do tests 22 and 23.
01291 *
01292                DO 600 I = 1, N
01293                   D3( I ) = DBLE( A( I, I ) )
01294   600          CONTINUE
01295                DO 610 I = 1, N - 1
01296                   D4( I ) = DBLE( A( I+1, I ) )
01297   610          CONTINUE
01298                CALL DSTT22( N, M2, 0, D3, D4, WA2, D2, Z, LDU, WORK,
01299      $                      MAX( 1, M2 ), RESULT( 22 ) )
01300 *
01301                NTEST = 24
01302                DO 620 I = 1, N - 1
01303                   D4( I ) = DBLE( A( I+1, I ) )
01304   620          CONTINUE
01305                SRNAMT = 'DSTEVR'
01306                CALL DSTEVR( 'N', 'V', N, D3, D4, VL, VU, IL, IU, ABSTOL,
01307      $                      M3, WA3, Z, LDU, IWORK, WORK, LWORK,
01308      $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
01309                IF( IINFO.NE.0 ) THEN
01310                   WRITE( NOUNIT, FMT = 9999 )'DSTEVR(N,V)', IINFO, N,
01311      $               JTYPE, IOLDSD
01312                   INFO = ABS( IINFO )
01313                   IF( IINFO.LT.0 ) THEN
01314                      RETURN
01315                   ELSE
01316                      RESULT( 24 ) = ULPINV
01317                      GO TO 630
01318                   END IF
01319                END IF
01320 *
01321 *              Do test 24.
01322 *
01323                TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
01324                TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
01325                RESULT( 24 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, TEMP3*ULP )
01326 *
01327   630          CONTINUE
01328 *
01329 *
01330 *
01331             ELSE
01332 *
01333                DO 640 I = 1, 24
01334                   RESULT( I ) = ZERO
01335   640          CONTINUE
01336                NTEST = 24
01337             END IF
01338 *
01339 *           Perform remaining tests storing upper or lower triangular
01340 *           part of matrix.
01341 *
01342             DO 1720 IUPLO = 0, 1
01343                IF( IUPLO.EQ.0 ) THEN
01344                   UPLO = 'L'
01345                ELSE
01346                   UPLO = 'U'
01347                END IF
01348 *
01349 *              4)      Call DSYEV and DSYEVX.
01350 *
01351                CALL DLACPY( ' ', N, N, A, LDA, V, LDU )
01352 *
01353                NTEST = NTEST + 1
01354                SRNAMT = 'DSYEV'
01355                CALL DSYEV( 'V', UPLO, N, A, LDU, D1, WORK, LWORK,
01356      $                     IINFO )
01357                IF( IINFO.NE.0 ) THEN
01358                   WRITE( NOUNIT, FMT = 9999 )'DSYEV(V,' // UPLO // ')',
01359      $               IINFO, N, JTYPE, IOLDSD
01360                   INFO = ABS( IINFO )
01361                   IF( IINFO.LT.0 ) THEN
01362                      RETURN
01363                   ELSE
01364                      RESULT( NTEST ) = ULPINV
01365                      RESULT( NTEST+1 ) = ULPINV
01366                      RESULT( NTEST+2 ) = ULPINV
01367                      GO TO 660
01368                   END IF
01369                END IF
01370 *
01371 *              Do tests 25 and 26 (or +54)
01372 *
01373                CALL DSYT21( 1, UPLO, N, 0, V, LDU, D1, D2, A, LDU, Z,
01374      $                      LDU, TAU, WORK, RESULT( NTEST ) )
01375 *
01376                CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
01377 *
01378                NTEST = NTEST + 2
01379                SRNAMT = 'DSYEV'
01380                CALL DSYEV( 'N', UPLO, N, A, LDU, D3, WORK, LWORK,
01381      $                     IINFO )
01382                IF( IINFO.NE.0 ) THEN
01383                   WRITE( NOUNIT, FMT = 9999 )'DSYEV(N,' // UPLO // ')',
01384      $               IINFO, N, JTYPE, IOLDSD
01385                   INFO = ABS( IINFO )
01386                   IF( IINFO.LT.0 ) THEN
01387                      RETURN
01388                   ELSE
01389                      RESULT( NTEST ) = ULPINV
01390                      GO TO 660
01391                   END IF
01392                END IF
01393 *
01394 *              Do test 27 (or +54)
01395 *
01396                TEMP1 = ZERO
01397                TEMP2 = ZERO
01398                DO 650 J = 1, N
01399                   TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
01400                   TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
01401   650          CONTINUE
01402                RESULT( NTEST ) = TEMP2 / MAX( UNFL,
01403      $                           ULP*MAX( TEMP1, TEMP2 ) )
01404 *
01405   660          CONTINUE
01406                CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
01407 *
01408                NTEST = NTEST + 1
01409 *
01410                IF( N.GT.0 ) THEN
01411                   TEMP3 = MAX( ABS( D1( 1 ) ), ABS( D1( N ) ) )
01412                   IF( IL.NE.1 ) THEN
01413                      VL = D1( IL ) - MAX( HALF*( D1( IL )-D1( IL-1 ) ),
01414      $                    TEN*ULP*TEMP3, TEN*RTUNFL )
01415                   ELSE IF( N.GT.0 ) THEN
01416                      VL = D1( 1 ) - MAX( HALF*( D1( N )-D1( 1 ) ),
01417      $                    TEN*ULP*TEMP3, TEN*RTUNFL )
01418                   END IF
01419                   IF( IU.NE.N ) THEN
01420                      VU = D1( IU ) + MAX( HALF*( D1( IU+1 )-D1( IU ) ),
01421      $                    TEN*ULP*TEMP3, TEN*RTUNFL )
01422                   ELSE IF( N.GT.0 ) THEN
01423                      VU = D1( N ) + MAX( HALF*( D1( N )-D1( 1 ) ),
01424      $                    TEN*ULP*TEMP3, TEN*RTUNFL )
01425                   END IF
01426                ELSE
01427                   TEMP3 = ZERO
01428                   VL = ZERO
01429                   VU = ONE
01430                END IF
01431 *
01432                SRNAMT = 'DSYEVX'
01433                CALL DSYEVX( 'V', 'A', UPLO, N, A, LDU, VL, VU, IL, IU,
01434      $                      ABSTOL, M, WA1, Z, LDU, WORK, LWORK, IWORK,
01435      $                      IWORK( 5*N+1 ), IINFO )
01436                IF( IINFO.NE.0 ) THEN
01437                   WRITE( NOUNIT, FMT = 9999 )'DSYEVX(V,A,' // UPLO //
01438      $               ')', IINFO, N, JTYPE, IOLDSD
01439                   INFO = ABS( IINFO )
01440                   IF( IINFO.LT.0 ) THEN
01441                      RETURN
01442                   ELSE
01443                      RESULT( NTEST ) = ULPINV
01444                      RESULT( NTEST+1 ) = ULPINV
01445                      RESULT( NTEST+2 ) = ULPINV
01446                      GO TO 680
01447                   END IF
01448                END IF
01449 *
01450 *              Do tests 28 and 29 (or +54)
01451 *
01452                CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
01453 *
01454                CALL DSYT21( 1, UPLO, N, 0, A, LDU, D1, D2, Z, LDU, V,
01455      $                      LDU, TAU, WORK, RESULT( NTEST ) )
01456 *
01457                NTEST = NTEST + 2
01458                SRNAMT = 'DSYEVX'
01459                CALL DSYEVX( 'N', 'A', UPLO, N, A, LDU, VL, VU, IL, IU,
01460      $                      ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, IWORK,
01461      $                      IWORK( 5*N+1 ), IINFO )
01462                IF( IINFO.NE.0 ) THEN
01463                   WRITE( NOUNIT, FMT = 9999 )'DSYEVX(N,A,' // UPLO //
01464      $               ')', IINFO, N, JTYPE, IOLDSD
01465                   INFO = ABS( IINFO )
01466                   IF( IINFO.LT.0 ) THEN
01467                      RETURN
01468                   ELSE
01469                      RESULT( NTEST ) = ULPINV
01470                      GO TO 680
01471                   END IF
01472                END IF
01473 *
01474 *              Do test 30 (or +54)
01475 *
01476                TEMP1 = ZERO
01477                TEMP2 = ZERO
01478                DO 670 J = 1, N
01479                   TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) )
01480                   TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) )
01481   670          CONTINUE
01482                RESULT( NTEST ) = TEMP2 / MAX( UNFL,
01483      $                           ULP*MAX( TEMP1, TEMP2 ) )
01484 *
01485   680          CONTINUE
01486 *
01487                NTEST = NTEST + 1
01488                CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
01489                SRNAMT = 'DSYEVX'
01490                CALL DSYEVX( 'V', 'I', UPLO, N, A, LDU, VL, VU, IL, IU,
01491      $                      ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, IWORK,
01492      $                      IWORK( 5*N+1 ), IINFO )
01493                IF( IINFO.NE.0 ) THEN
01494                   WRITE( NOUNIT, FMT = 9999 )'DSYEVX(V,I,' // UPLO //
01495      $               ')', IINFO, N, JTYPE, IOLDSD
01496                   INFO = ABS( IINFO )
01497                   IF( IINFO.LT.0 ) THEN
01498                      RETURN
01499                   ELSE
01500                      RESULT( NTEST ) = ULPINV
01501                      RESULT( NTEST+1 ) = ULPINV
01502                      RESULT( NTEST+2 ) = ULPINV
01503                      GO TO 690
01504                   END IF
01505                END IF
01506 *
01507 *              Do tests 31 and 32 (or +54)
01508 *
01509                CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
01510 *
01511                CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
01512      $                      V, LDU, TAU, WORK, RESULT( NTEST ) )
01513 *
01514                NTEST = NTEST + 2
01515                CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
01516                SRNAMT = 'DSYEVX'
01517                CALL DSYEVX( 'N', 'I', UPLO, N, A, LDU, VL, VU, IL, IU,
01518      $                      ABSTOL, M3, WA3, Z, LDU, WORK, LWORK, IWORK,
01519      $                      IWORK( 5*N+1 ), IINFO )
01520                IF( IINFO.NE.0 ) THEN
01521                   WRITE( NOUNIT, FMT = 9999 )'DSYEVX(N,I,' // UPLO //
01522      $               ')', IINFO, N, JTYPE, IOLDSD
01523                   INFO = ABS( IINFO )
01524                   IF( IINFO.LT.0 ) THEN
01525                      RETURN
01526                   ELSE
01527                      RESULT( NTEST ) = ULPINV
01528                      GO TO 690
01529                   END IF
01530                END IF
01531 *
01532 *              Do test 33 (or +54)
01533 *
01534                TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
01535                TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
01536                RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
01537      $                           MAX( UNFL, ULP*TEMP3 )
01538   690          CONTINUE
01539 *
01540                NTEST = NTEST + 1
01541                CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
01542                SRNAMT = 'DSYEVX'
01543                CALL DSYEVX( 'V', 'V', UPLO, N, A, LDU, VL, VU, IL, IU,
01544      $                      ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, IWORK,
01545      $                      IWORK( 5*N+1 ), IINFO )
01546                IF( IINFO.NE.0 ) THEN
01547                   WRITE( NOUNIT, FMT = 9999 )'DSYEVX(V,V,' // UPLO //
01548      $               ')', IINFO, N, JTYPE, IOLDSD
01549                   INFO = ABS( IINFO )
01550                   IF( IINFO.LT.0 ) THEN
01551                      RETURN
01552                   ELSE
01553                      RESULT( NTEST ) = ULPINV
01554                      RESULT( NTEST+1 ) = ULPINV
01555                      RESULT( NTEST+2 ) = ULPINV
01556                      GO TO 700
01557                   END IF
01558                END IF
01559 *
01560 *              Do tests 34 and 35 (or +54)
01561 *
01562                CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
01563 *
01564                CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
01565      $                      V, LDU, TAU, WORK, RESULT( NTEST ) )
01566 *
01567                NTEST = NTEST + 2
01568                CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
01569                SRNAMT = 'DSYEVX'
01570                CALL DSYEVX( 'N', 'V', UPLO, N, A, LDU, VL, VU, IL, IU,
01571      $                      ABSTOL, M3, WA3, Z, LDU, WORK, LWORK, IWORK,
01572      $                      IWORK( 5*N+1 ), IINFO )
01573                IF( IINFO.NE.0 ) THEN
01574                   WRITE( NOUNIT, FMT = 9999 )'DSYEVX(N,V,' // UPLO //
01575      $               ')', IINFO, N, JTYPE, IOLDSD
01576                   INFO = ABS( IINFO )
01577                   IF( IINFO.LT.0 ) THEN
01578                      RETURN
01579                   ELSE
01580                      RESULT( NTEST ) = ULPINV
01581                      GO TO 700
01582                   END IF
01583                END IF
01584 *
01585                IF( M3.EQ.0 .AND. N.GT.0 ) THEN
01586                   RESULT( NTEST ) = ULPINV
01587                   GO TO 700
01588                END IF
01589 *
01590 *              Do test 36 (or +54)
01591 *
01592                TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
01593                TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
01594                IF( N.GT.0 ) THEN
01595                   TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
01596                ELSE
01597                   TEMP3 = ZERO
01598                END IF
01599                RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
01600      $                           MAX( UNFL, TEMP3*ULP )
01601 *
01602   700          CONTINUE
01603 *
01604 *              5)      Call DSPEV and DSPEVX.
01605 *
01606                CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
01607 *
01608 *              Load array WORK with the upper or lower triangular
01609 *              part of the matrix in packed form.
01610 *
01611                IF( IUPLO.EQ.1 ) THEN
01612                   INDX = 1
01613                   DO 720 J = 1, N
01614                      DO 710 I = 1, J
01615                         WORK( INDX ) = A( I, J )
01616                         INDX = INDX + 1
01617   710                CONTINUE
01618   720             CONTINUE
01619                ELSE
01620                   INDX = 1
01621                   DO 740 J = 1, N
01622                      DO 730 I = J, N
01623                         WORK( INDX ) = A( I, J )
01624                         INDX = INDX + 1
01625   730                CONTINUE
01626   740             CONTINUE
01627                END IF
01628 *
01629                NTEST = NTEST + 1
01630                SRNAMT = 'DSPEV'
01631                CALL DSPEV( 'V', UPLO, N, WORK, D1, Z, LDU, V, IINFO )
01632                IF( IINFO.NE.0 ) THEN
01633                   WRITE( NOUNIT, FMT = 9999 )'DSPEV(V,' // UPLO // ')',
01634      $               IINFO, N, JTYPE, IOLDSD
01635                   INFO = ABS( IINFO )
01636                   IF( IINFO.LT.0 ) THEN
01637                      RETURN
01638                   ELSE
01639                      RESULT( NTEST ) = ULPINV
01640                      RESULT( NTEST+1 ) = ULPINV
01641                      RESULT( NTEST+2 ) = ULPINV
01642                      GO TO 800
01643                   END IF
01644                END IF
01645 *
01646 *              Do tests 37 and 38 (or +54)
01647 *
01648                CALL DSYT21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V,
01649      $                      LDU, TAU, WORK, RESULT( NTEST ) )
01650 *
01651                IF( IUPLO.EQ.1 ) THEN
01652                   INDX = 1
01653                   DO 760 J = 1, N
01654                      DO 750 I = 1, J
01655                         WORK( INDX ) = A( I, J )
01656                         INDX = INDX + 1
01657   750                CONTINUE
01658   760             CONTINUE
01659                ELSE
01660                   INDX = 1
01661                   DO 780 J = 1, N
01662                      DO 770 I = J, N
01663                         WORK( INDX ) = A( I, J )
01664                         INDX = INDX + 1
01665   770                CONTINUE
01666   780             CONTINUE
01667                END IF
01668 *
01669                NTEST = NTEST + 2
01670                SRNAMT = 'DSPEV'
01671                CALL DSPEV( 'N', UPLO, N, WORK, D3, Z, LDU, V, IINFO )
01672                IF( IINFO.NE.0 ) THEN
01673                   WRITE( NOUNIT, FMT = 9999 )'DSPEV(N,' // UPLO // ')',
01674      $               IINFO, N, JTYPE, IOLDSD
01675                   INFO = ABS( IINFO )
01676                   IF( IINFO.LT.0 ) THEN
01677                      RETURN
01678                   ELSE
01679                      RESULT( NTEST ) = ULPINV
01680                      GO TO 800
01681                   END IF
01682                END IF
01683 *
01684 *              Do test 39 (or +54)
01685 *
01686                TEMP1 = ZERO
01687                TEMP2 = ZERO
01688                DO 790 J = 1, N
01689                   TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
01690                   TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
01691   790          CONTINUE
01692                RESULT( NTEST ) = TEMP2 / MAX( UNFL,
01693      $                           ULP*MAX( TEMP1, TEMP2 ) )
01694 *
01695 *              Load array WORK with the upper or lower triangular part
01696 *              of the matrix in packed form.
01697 *
01698   800          CONTINUE
01699                IF( IUPLO.EQ.1 ) THEN
01700                   INDX = 1
01701                   DO 820 J = 1, N
01702                      DO 810 I = 1, J
01703                         WORK( INDX ) = A( I, J )
01704                         INDX = INDX + 1
01705   810                CONTINUE
01706   820             CONTINUE
01707                ELSE
01708                   INDX = 1
01709                   DO 840 J = 1, N
01710                      DO 830 I = J, N
01711                         WORK( INDX ) = A( I, J )
01712                         INDX = INDX + 1
01713   830                CONTINUE
01714   840             CONTINUE
01715                END IF
01716 *
01717                NTEST = NTEST + 1
01718 *
01719                IF( N.GT.0 ) THEN
01720                   TEMP3 = MAX( ABS( D1( 1 ) ), ABS( D1( N ) ) )
01721                   IF( IL.NE.1 ) THEN
01722                      VL = D1( IL ) - MAX( HALF*( D1( IL )-D1( IL-1 ) ),
01723      $                    TEN*ULP*TEMP3, TEN*RTUNFL )
01724                   ELSE IF( N.GT.0 ) THEN
01725                      VL = D1( 1 ) - MAX( HALF*( D1( N )-D1( 1 ) ),
01726      $                    TEN*ULP*TEMP3, TEN*RTUNFL )
01727                   END IF
01728                   IF( IU.NE.N ) THEN
01729                      VU = D1( IU ) + MAX( HALF*( D1( IU+1 )-D1( IU ) ),
01730      $                    TEN*ULP*TEMP3, TEN*RTUNFL )
01731                   ELSE IF( N.GT.0 ) THEN
01732                      VU = D1( N ) + MAX( HALF*( D1( N )-D1( 1 ) ),
01733      $                    TEN*ULP*TEMP3, TEN*RTUNFL )
01734                   END IF
01735                ELSE
01736                   TEMP3 = ZERO
01737                   VL = ZERO
01738                   VU = ONE
01739                END IF
01740 *
01741                SRNAMT = 'DSPEVX'
01742                CALL DSPEVX( 'V', 'A', UPLO, N, WORK, VL, VU, IL, IU,
01743      $                      ABSTOL, M, WA1, Z, LDU, V, IWORK,
01744      $                      IWORK( 5*N+1 ), IINFO )
01745                IF( IINFO.NE.0 ) THEN
01746                   WRITE( NOUNIT, FMT = 9999 )'DSPEVX(V,A,' // UPLO //
01747      $               ')', IINFO, N, JTYPE, IOLDSD
01748                   INFO = ABS( IINFO )
01749                   IF( IINFO.LT.0 ) THEN
01750                      RETURN
01751                   ELSE
01752                      RESULT( NTEST ) = ULPINV
01753                      RESULT( NTEST+1 ) = ULPINV
01754                      RESULT( NTEST+2 ) = ULPINV
01755                      GO TO 900
01756                   END IF
01757                END IF
01758 *
01759 *              Do tests 40 and 41 (or +54)
01760 *
01761                CALL DSYT21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V,
01762      $                      LDU, TAU, WORK, RESULT( NTEST ) )
01763 *
01764                NTEST = NTEST + 2
01765 *
01766                IF( IUPLO.EQ.1 ) THEN
01767                   INDX = 1
01768                   DO 860 J = 1, N
01769                      DO 850 I = 1, J
01770                         WORK( INDX ) = A( I, J )
01771                         INDX = INDX + 1
01772   850                CONTINUE
01773   860             CONTINUE
01774                ELSE
01775                   INDX = 1
01776                   DO 880 J = 1, N
01777                      DO 870 I = J, N
01778                         WORK( INDX ) = A( I, J )
01779                         INDX = INDX + 1
01780   870                CONTINUE
01781   880             CONTINUE
01782                END IF
01783 *
01784                SRNAMT = 'DSPEVX'
01785                CALL DSPEVX( 'N', 'A', UPLO, N, WORK, VL, VU, IL, IU,
01786      $                      ABSTOL, M2, WA2, Z, LDU, V, IWORK,
01787      $                      IWORK( 5*N+1 ), IINFO )
01788                IF( IINFO.NE.0 ) THEN
01789                   WRITE( NOUNIT, FMT = 9999 )'DSPEVX(N,A,' // UPLO //
01790      $               ')', IINFO, N, JTYPE, IOLDSD
01791                   INFO = ABS( IINFO )
01792                   IF( IINFO.LT.0 ) THEN
01793                      RETURN
01794                   ELSE
01795                      RESULT( NTEST ) = ULPINV
01796                      GO TO 900
01797                   END IF
01798                END IF
01799 *
01800 *              Do test 42 (or +54)
01801 *
01802                TEMP1 = ZERO
01803                TEMP2 = ZERO
01804                DO 890 J = 1, N
01805                   TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) )
01806                   TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) )
01807   890          CONTINUE
01808                RESULT( NTEST ) = TEMP2 / MAX( UNFL,
01809      $                           ULP*MAX( TEMP1, TEMP2 ) )
01810 *
01811   900          CONTINUE
01812                IF( IUPLO.EQ.1 ) THEN
01813                   INDX = 1
01814                   DO 920 J = 1, N
01815                      DO 910 I = 1, J
01816                         WORK( INDX ) = A( I, J )
01817                         INDX = INDX + 1
01818   910                CONTINUE
01819   920             CONTINUE
01820                ELSE
01821                   INDX = 1
01822                   DO 940 J = 1, N
01823                      DO 930 I = J, N
01824                         WORK( INDX ) = A( I, J )
01825                         INDX = INDX + 1
01826   930                CONTINUE
01827   940             CONTINUE
01828                END IF
01829 *
01830                NTEST = NTEST + 1
01831 *
01832                SRNAMT = 'DSPEVX'
01833                CALL DSPEVX( 'V', 'I', UPLO, N, WORK, VL, VU, IL, IU,
01834      $                      ABSTOL, M2, WA2, Z, LDU, V, IWORK,
01835      $                      IWORK( 5*N+1 ), IINFO )
01836                IF( IINFO.NE.0 ) THEN
01837                   WRITE( NOUNIT, FMT = 9999 )'DSPEVX(V,I,' // UPLO //
01838      $               ')', IINFO, N, JTYPE, IOLDSD
01839                   INFO = ABS( IINFO )
01840                   IF( IINFO.LT.0 ) THEN
01841                      RETURN
01842                   ELSE
01843                      RESULT( NTEST ) = ULPINV
01844                      RESULT( NTEST+1 ) = ULPINV
01845                      RESULT( NTEST+2 ) = ULPINV
01846                      GO TO 990
01847                   END IF
01848                END IF
01849 *
01850 *              Do tests 43 and 44 (or +54)
01851 *
01852                CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
01853      $                      V, LDU, TAU, WORK, RESULT( NTEST ) )
01854 *
01855                NTEST = NTEST + 2
01856 *
01857                IF( IUPLO.EQ.1 ) THEN
01858                   INDX = 1
01859                   DO 960 J = 1, N
01860                      DO 950 I = 1, J
01861                         WORK( INDX ) = A( I, J )
01862                         INDX = INDX + 1
01863   950                CONTINUE
01864   960             CONTINUE
01865                ELSE
01866                   INDX = 1
01867                   DO 980 J = 1, N
01868                      DO 970 I = J, N
01869                         WORK( INDX ) = A( I, J )
01870                         INDX = INDX + 1
01871   970                CONTINUE
01872   980             CONTINUE
01873                END IF
01874 *
01875                SRNAMT = 'DSPEVX'
01876                CALL DSPEVX( 'N', 'I', UPLO, N, WORK, VL, VU, IL, IU,
01877      $                      ABSTOL, M3, WA3, Z, LDU, V, IWORK,
01878      $                      IWORK( 5*N+1 ), IINFO )
01879                IF( IINFO.NE.0 ) THEN
01880                   WRITE( NOUNIT, FMT = 9999 )'DSPEVX(N,I,' // UPLO //
01881      $               ')', IINFO, N, JTYPE, IOLDSD
01882                   INFO = ABS( IINFO )
01883                   IF( IINFO.LT.0 ) THEN
01884                      RETURN
01885                   ELSE
01886                      RESULT( NTEST ) = ULPINV
01887                      GO TO 990
01888                   END IF
01889                END IF
01890 *
01891                IF( M3.EQ.0 .AND. N.GT.0 ) THEN
01892                   RESULT( NTEST ) = ULPINV
01893                   GO TO 990
01894                END IF
01895 *
01896 *              Do test 45 (or +54)
01897 *
01898                TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
01899                TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
01900                IF( N.GT.0 ) THEN
01901                   TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
01902                ELSE
01903                   TEMP3 = ZERO
01904                END IF
01905                RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
01906      $                           MAX( UNFL, TEMP3*ULP )
01907 *
01908   990          CONTINUE
01909                IF( IUPLO.EQ.1 ) THEN
01910                   INDX = 1
01911                   DO 1010 J = 1, N
01912                      DO 1000 I = 1, J
01913                         WORK( INDX ) = A( I, J )
01914                         INDX = INDX + 1
01915  1000                CONTINUE
01916  1010             CONTINUE
01917                ELSE
01918                   INDX = 1
01919                   DO 1030 J = 1, N
01920                      DO 1020 I = J, N
01921                         WORK( INDX ) = A( I, J )
01922                         INDX = INDX + 1
01923  1020                CONTINUE
01924  1030             CONTINUE
01925                END IF
01926 *
01927                NTEST = NTEST + 1
01928 *
01929                SRNAMT = 'DSPEVX'
01930                CALL DSPEVX( 'V', 'V', UPLO, N, WORK, VL, VU, IL, IU,
01931      $                      ABSTOL, M2, WA2, Z, LDU, V, IWORK,
01932      $                      IWORK( 5*N+1 ), IINFO )
01933                IF( IINFO.NE.0 ) THEN
01934                   WRITE( NOUNIT, FMT = 9999 )'DSPEVX(V,V,' // UPLO //
01935      $               ')', IINFO, N, JTYPE, IOLDSD
01936                   INFO = ABS( IINFO )
01937                   IF( IINFO.LT.0 ) THEN
01938                      RETURN
01939                   ELSE
01940                      RESULT( NTEST ) = ULPINV
01941                      RESULT( NTEST+1 ) = ULPINV
01942                      RESULT( NTEST+2 ) = ULPINV
01943                      GO TO 1080
01944                   END IF
01945                END IF
01946 *
01947 *              Do tests 46 and 47 (or +54)
01948 *
01949                CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
01950      $                      V, LDU, TAU, WORK, RESULT( NTEST ) )
01951 *
01952                NTEST = NTEST + 2
01953 *
01954                IF( IUPLO.EQ.1 ) THEN
01955                   INDX = 1
01956                   DO 1050 J = 1, N
01957                      DO 1040 I = 1, J
01958                         WORK( INDX ) = A( I, J )
01959                         INDX = INDX + 1
01960  1040                CONTINUE
01961  1050             CONTINUE
01962                ELSE
01963                   INDX = 1
01964                   DO 1070 J = 1, N
01965                      DO 1060 I = J, N
01966                         WORK( INDX ) = A( I, J )
01967                         INDX = INDX + 1
01968  1060                CONTINUE
01969  1070             CONTINUE
01970                END IF
01971 *
01972                SRNAMT = 'DSPEVX'
01973                CALL DSPEVX( 'N', 'V', UPLO, N, WORK, VL, VU, IL, IU,
01974      $                      ABSTOL, M3, WA3, Z, LDU, V, IWORK,
01975      $                      IWORK( 5*N+1 ), IINFO )
01976                IF( IINFO.NE.0 ) THEN
01977                   WRITE( NOUNIT, FMT = 9999 )'DSPEVX(N,V,' // UPLO //
01978      $               ')', IINFO, N, JTYPE, IOLDSD
01979                   INFO = ABS( IINFO )
01980                   IF( IINFO.LT.0 ) THEN
01981                      RETURN
01982                   ELSE
01983                      RESULT( NTEST ) = ULPINV
01984                      GO TO 1080
01985                   END IF
01986                END IF
01987 *
01988                IF( M3.EQ.0 .AND. N.GT.0 ) THEN
01989                   RESULT( NTEST ) = ULPINV
01990                   GO TO 1080
01991                END IF
01992 *
01993 *              Do test 48 (or +54)
01994 *
01995                TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
01996                TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
01997                IF( N.GT.0 ) THEN
01998                   TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
01999                ELSE
02000                   TEMP3 = ZERO
02001                END IF
02002                RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
02003      $                           MAX( UNFL, TEMP3*ULP )
02004 *
02005  1080          CONTINUE
02006 *
02007 *              6)      Call DSBEV and DSBEVX.
02008 *
02009                IF( JTYPE.LE.7 ) THEN
02010                   KD = 1
02011                ELSE IF( JTYPE.GE.8 .AND. JTYPE.LE.15 ) THEN
02012                   KD = MAX( N-1, 0 )
02013                ELSE
02014                   KD = IHBW
02015                END IF
02016 *
02017 *              Load array V with the upper or lower triangular part
02018 *              of the matrix in band form.
02019 *
02020                IF( IUPLO.EQ.1 ) THEN
02021                   DO 1100 J = 1, N
02022                      DO 1090 I = MAX( 1, J-KD ), J
02023                         V( KD+1+I-J, J ) = A( I, J )
02024  1090                CONTINUE
02025  1100             CONTINUE
02026                ELSE
02027                   DO 1120 J = 1, N
02028                      DO 1110 I = J, MIN( N, J+KD )
02029                         V( 1+I-J, J ) = A( I, J )
02030  1110                CONTINUE
02031  1120             CONTINUE
02032                END IF
02033 *
02034                NTEST = NTEST + 1
02035                SRNAMT = 'DSBEV'
02036                CALL DSBEV( 'V', UPLO, N, KD, V, LDU, D1, Z, LDU, WORK,
02037      $                     IINFO )
02038                IF( IINFO.NE.0 ) THEN
02039                   WRITE( NOUNIT, FMT = 9999 )'DSBEV(V,' // UPLO // ')',
02040      $               IINFO, N, JTYPE, IOLDSD
02041                   INFO = ABS( IINFO )
02042                   IF( IINFO.LT.0 ) THEN
02043                      RETURN
02044                   ELSE
02045                      RESULT( NTEST ) = ULPINV
02046                      RESULT( NTEST+1 ) = ULPINV
02047                      RESULT( NTEST+2 ) = ULPINV
02048                      GO TO 1180
02049                   END IF
02050                END IF
02051 *
02052 *              Do tests 49 and 50 (or ... )
02053 *
02054                CALL DSYT21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V,
02055      $                      LDU, TAU, WORK, RESULT( NTEST ) )
02056 *
02057                IF( IUPLO.EQ.1 ) THEN
02058                   DO 1140 J = 1, N
02059                      DO 1130 I = MAX( 1, J-KD ), J
02060                         V( KD+1+I-J, J ) = A( I, J )
02061  1130                CONTINUE
02062  1140             CONTINUE
02063                ELSE
02064                   DO 1160 J = 1, N
02065                      DO 1150 I = J, MIN( N, J+KD )
02066                         V( 1+I-J, J ) = A( I, J )
02067  1150                CONTINUE
02068  1160             CONTINUE
02069                END IF
02070 *
02071                NTEST = NTEST + 2
02072                SRNAMT = 'DSBEV'
02073                CALL DSBEV( 'N', UPLO, N, KD, V, LDU, D3, Z, LDU, WORK,
02074      $                     IINFO )
02075                IF( IINFO.NE.0 ) THEN
02076                   WRITE( NOUNIT, FMT = 9999 )'DSBEV(N,' // UPLO // ')',
02077      $               IINFO, N, JTYPE, IOLDSD
02078                   INFO = ABS( IINFO )
02079                   IF( IINFO.LT.0 ) THEN
02080                      RETURN
02081                   ELSE
02082                      RESULT( NTEST ) = ULPINV
02083                      GO TO 1180
02084                   END IF
02085                END IF
02086 *
02087 *              Do test 51 (or +54)
02088 *
02089                TEMP1 = ZERO
02090                TEMP2 = ZERO
02091                DO 1170 J = 1, N
02092                   TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
02093                   TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
02094  1170          CONTINUE
02095                RESULT( NTEST ) = TEMP2 / MAX( UNFL,
02096      $                           ULP*MAX( TEMP1, TEMP2 ) )
02097 *
02098 *              Load array V with the upper or lower triangular part
02099 *              of the matrix in band form.
02100 *
02101  1180          CONTINUE
02102                IF( IUPLO.EQ.1 ) THEN
02103                   DO 1200 J = 1, N
02104                      DO 1190 I = MAX( 1, J-KD ), J
02105                         V( KD+1+I-J, J ) = A( I, J )
02106  1190                CONTINUE
02107  1200             CONTINUE
02108                ELSE
02109                   DO 1220 J = 1, N
02110                      DO 1210 I = J, MIN( N, J+KD )
02111                         V( 1+I-J, J ) = A( I, J )
02112  1210                CONTINUE
02113  1220             CONTINUE
02114                END IF
02115 *
02116                NTEST = NTEST + 1
02117                SRNAMT = 'DSBEVX'
02118                CALL DSBEVX( 'V', 'A', UPLO, N, KD, V, LDU, U, LDU, VL,
02119      $                      VU, IL, IU, ABSTOL, M, WA2, Z, LDU, WORK,
02120      $                      IWORK, IWORK( 5*N+1 ), IINFO )
02121                IF( IINFO.NE.0 ) THEN
02122                   WRITE( NOUNIT, FMT = 9999 )'DSBEVX(V,A,' // UPLO //
02123      $               ')', IINFO, N, JTYPE, IOLDSD
02124                   INFO = ABS( IINFO )
02125                   IF( IINFO.LT.0 ) THEN
02126                      RETURN
02127                   ELSE
02128                      RESULT( NTEST ) = ULPINV
02129                      RESULT( NTEST+1 ) = ULPINV
02130                      RESULT( NTEST+2 ) = ULPINV
02131                      GO TO 1280
02132                   END IF
02133                END IF
02134 *
02135 *              Do tests 52 and 53 (or +54)
02136 *
02137                CALL DSYT21( 1, UPLO, N, 0, A, LDU, WA2, D2, Z, LDU, V,
02138      $                      LDU, TAU, WORK, RESULT( NTEST ) )
02139 *
02140                NTEST = NTEST + 2
02141 *
02142                IF( IUPLO.EQ.1 ) THEN
02143                   DO 1240 J = 1, N
02144                      DO 1230 I = MAX( 1, J-KD ), J
02145                         V( KD+1+I-J, J ) = A( I, J )
02146  1230                CONTINUE
02147  1240             CONTINUE
02148                ELSE
02149                   DO 1260 J = 1, N
02150                      DO 1250 I = J, MIN( N, J+KD )
02151                         V( 1+I-J, J ) = A( I, J )
02152  1250                CONTINUE
02153  1260             CONTINUE
02154                END IF
02155 *
02156                SRNAMT = 'DSBEVX'
02157                CALL DSBEVX( 'N', 'A', UPLO, N, KD, V, LDU, U, LDU, VL,
02158      $                      VU, IL, IU, ABSTOL, M3, WA3, Z, LDU, WORK,
02159      $                      IWORK, IWORK( 5*N+1 ), IINFO )
02160                IF( IINFO.NE.0 ) THEN
02161                   WRITE( NOUNIT, FMT = 9999 )'DSBEVX(N,A,' // UPLO //
02162      $               ')', IINFO, N, JTYPE, IOLDSD
02163                   INFO = ABS( IINFO )
02164                   IF( IINFO.LT.0 ) THEN
02165                      RETURN
02166                   ELSE
02167                      RESULT( NTEST ) = ULPINV
02168                      GO TO 1280
02169                   END IF
02170                END IF
02171 *
02172 *              Do test 54 (or +54)
02173 *
02174                TEMP1 = ZERO
02175                TEMP2 = ZERO
02176                DO 1270 J = 1, N
02177                   TEMP1 = MAX( TEMP1, ABS( WA2( J ) ), ABS( WA3( J ) ) )
02178                   TEMP2 = MAX( TEMP2, ABS( WA2( J )-WA3( J ) ) )
02179  1270          CONTINUE
02180                RESULT( NTEST ) = TEMP2 / MAX( UNFL,
02181      $                           ULP*MAX( TEMP1, TEMP2 ) )
02182 *
02183  1280          CONTINUE
02184                NTEST = NTEST + 1
02185                IF( IUPLO.EQ.1 ) THEN
02186                   DO 1300 J = 1, N
02187                      DO 1290 I = MAX( 1, J-KD ), J
02188                         V( KD+1+I-J, J ) = A( I, J )
02189  1290                CONTINUE
02190  1300             CONTINUE
02191                ELSE
02192                   DO 1320 J = 1, N
02193                      DO 1310 I = J, MIN( N, J+KD )
02194                         V( 1+I-J, J ) = A( I, J )
02195  1310                CONTINUE
02196  1320             CONTINUE
02197                END IF
02198 *
02199                SRNAMT = 'DSBEVX'
02200                CALL DSBEVX( 'V', 'I', UPLO, N, KD, V, LDU, U, LDU, VL,
02201      $                      VU, IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK,
02202      $                      IWORK, IWORK( 5*N+1 ), IINFO )
02203                IF( IINFO.NE.0 ) THEN
02204                   WRITE( NOUNIT, FMT = 9999 )'DSBEVX(V,I,' // UPLO //
02205      $               ')', IINFO, N, JTYPE, IOLDSD
02206                   INFO = ABS( IINFO )
02207                   IF( IINFO.LT.0 ) THEN
02208                      RETURN
02209                   ELSE
02210                      RESULT( NTEST ) = ULPINV
02211                      RESULT( NTEST+1 ) = ULPINV
02212                      RESULT( NTEST+2 ) = ULPINV
02213                      GO TO 1370
02214                   END IF
02215                END IF
02216 *
02217 *              Do tests 55 and 56 (or +54)
02218 *
02219                CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
02220      $                      V, LDU, TAU, WORK, RESULT( NTEST ) )
02221 *
02222                NTEST = NTEST + 2
02223 *
02224                IF( IUPLO.EQ.1 ) THEN
02225                   DO 1340 J = 1, N
02226                      DO 1330 I = MAX( 1, J-KD ), J
02227                         V( KD+1+I-J, J ) = A( I, J )
02228  1330                CONTINUE
02229  1340             CONTINUE
02230                ELSE
02231                   DO 1360 J = 1, N
02232                      DO 1350 I = J, MIN( N, J+KD )
02233                         V( 1+I-J, J ) = A( I, J )
02234  1350                CONTINUE
02235  1360             CONTINUE
02236                END IF
02237 *
02238                SRNAMT = 'DSBEVX'
02239                CALL DSBEVX( 'N', 'I', UPLO, N, KD, V, LDU, U, LDU, VL,
02240      $                      VU, IL, IU, ABSTOL, M3, WA3, Z, LDU, WORK,
02241      $                      IWORK, IWORK( 5*N+1 ), IINFO )
02242                IF( IINFO.NE.0 ) THEN
02243                   WRITE( NOUNIT, FMT = 9999 )'DSBEVX(N,I,' // UPLO //
02244      $               ')', IINFO, N, JTYPE, IOLDSD
02245                   INFO = ABS( IINFO )
02246                   IF( IINFO.LT.0 ) THEN
02247                      RETURN
02248                   ELSE
02249                      RESULT( NTEST ) = ULPINV
02250                      GO TO 1370
02251                   END IF
02252                END IF
02253 *
02254 *              Do test 57 (or +54)
02255 *
02256                TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
02257                TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
02258                IF( N.GT.0 ) THEN
02259                   TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
02260                ELSE
02261                   TEMP3 = ZERO
02262                END IF
02263                RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
02264      $                           MAX( UNFL, TEMP3*ULP )
02265 *
02266  1370          CONTINUE
02267                NTEST = NTEST + 1
02268                IF( IUPLO.EQ.1 ) THEN
02269                   DO 1390 J = 1, N
02270                      DO 1380 I = MAX( 1, J-KD ), J
02271                         V( KD+1+I-J, J ) = A( I, J )
02272  1380                CONTINUE
02273  1390             CONTINUE
02274                ELSE
02275                   DO 1410 J = 1, N
02276                      DO 1400 I = J, MIN( N, J+KD )
02277                         V( 1+I-J, J ) = A( I, J )
02278  1400                CONTINUE
02279  1410             CONTINUE
02280                END IF
02281 *
02282                SRNAMT = 'DSBEVX'
02283                CALL DSBEVX( 'V', 'V', UPLO, N, KD, V, LDU, U, LDU, VL,
02284      $                      VU, IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK,
02285      $                      IWORK, IWORK( 5*N+1 ), IINFO )
02286                IF( IINFO.NE.0 ) THEN
02287                   WRITE( NOUNIT, FMT = 9999 )'DSBEVX(V,V,' // UPLO //
02288      $               ')', IINFO, N, JTYPE, IOLDSD
02289                   INFO = ABS( IINFO )
02290                   IF( IINFO.LT.0 ) THEN
02291                      RETURN
02292                   ELSE
02293                      RESULT( NTEST ) = ULPINV
02294                      RESULT( NTEST+1 ) = ULPINV
02295                      RESULT( NTEST+2 ) = ULPINV
02296                      GO TO 1460
02297                   END IF
02298                END IF
02299 *
02300 *              Do tests 58 and 59 (or +54)
02301 *
02302                CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
02303      $                      V, LDU, TAU, WORK, RESULT( NTEST ) )
02304 *
02305                NTEST = NTEST + 2
02306 *
02307                IF( IUPLO.EQ.1 ) THEN
02308                   DO 1430 J = 1, N
02309                      DO 1420 I = MAX( 1, J-KD ), J
02310                         V( KD+1+I-J, J ) = A( I, J )
02311  1420                CONTINUE
02312  1430             CONTINUE
02313                ELSE
02314                   DO 1450 J = 1, N
02315                      DO 1440 I = J, MIN( N, J+KD )
02316                         V( 1+I-J, J ) = A( I, J )
02317  1440                CONTINUE
02318  1450             CONTINUE
02319                END IF
02320 *
02321                SRNAMT = 'DSBEVX'
02322                CALL DSBEVX( 'N', 'V', UPLO, N, KD, V, LDU, U, LDU, VL,
02323      $                      VU, IL, IU, ABSTOL, M3, WA3, Z, LDU, WORK,
02324      $                      IWORK, IWORK( 5*N+1 ), IINFO )
02325                IF( IINFO.NE.0 ) THEN
02326                   WRITE( NOUNIT, FMT = 9999 )'DSBEVX(N,V,' // UPLO //
02327      $               ')', IINFO, N, JTYPE, IOLDSD
02328                   INFO = ABS( IINFO )
02329                   IF( IINFO.LT.0 ) THEN
02330                      RETURN
02331                   ELSE
02332                      RESULT( NTEST ) = ULPINV
02333                      GO TO 1460
02334                   END IF
02335                END IF
02336 *
02337                IF( M3.EQ.0 .AND. N.GT.0 ) THEN
02338                   RESULT( NTEST ) = ULPINV
02339                   GO TO 1460
02340                END IF
02341 *
02342 *              Do test 60 (or +54)
02343 *
02344                TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
02345                TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
02346                IF( N.GT.0 ) THEN
02347                   TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
02348                ELSE
02349                   TEMP3 = ZERO
02350                END IF
02351                RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
02352      $                           MAX( UNFL, TEMP3*ULP )
02353 *
02354  1460          CONTINUE
02355 *
02356 *              7)      Call DSYEVD
02357 *
02358                CALL DLACPY( ' ', N, N, A, LDA, V, LDU )
02359 *
02360                NTEST = NTEST + 1
02361                SRNAMT = 'DSYEVD'
02362                CALL DSYEVD( 'V', UPLO, N, A, LDU, D1, WORK, LWEDC,
02363      $                      IWORK, LIWEDC, IINFO )
02364                IF( IINFO.NE.0 ) THEN
02365                   WRITE( NOUNIT, FMT = 9999 )'DSYEVD(V,' // UPLO //
02366      $               ')', IINFO, N, JTYPE, IOLDSD
02367                   INFO = ABS( IINFO )
02368                   IF( IINFO.LT.0 ) THEN
02369                      RETURN
02370                   ELSE
02371                      RESULT( NTEST ) = ULPINV
02372                      RESULT( NTEST+1 ) = ULPINV
02373                      RESULT( NTEST+2 ) = ULPINV
02374                      GO TO 1480
02375                   END IF
02376                END IF
02377 *
02378 *              Do tests 61 and 62 (or +54)
02379 *
02380                CALL DSYT21( 1, UPLO, N, 0, V, LDU, D1, D2, A, LDU, Z,
02381      $                      LDU, TAU, WORK, RESULT( NTEST ) )
02382 *
02383                CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
02384 *
02385                NTEST = NTEST + 2
02386                SRNAMT = 'DSYEVD'
02387                CALL DSYEVD( 'N', UPLO, N, A, LDU, D3, WORK, LWEDC,
02388      $                      IWORK, LIWEDC, IINFO )
02389                IF( IINFO.NE.0 ) THEN
02390                   WRITE( NOUNIT, FMT = 9999 )'DSYEVD(N,' // UPLO //
02391      $               ')', IINFO, N, JTYPE, IOLDSD
02392                   INFO = ABS( IINFO )
02393                   IF( IINFO.LT.0 ) THEN
02394                      RETURN
02395                   ELSE
02396                      RESULT( NTEST ) = ULPINV
02397                      GO TO 1480
02398                   END IF
02399                END IF
02400 *
02401 *              Do test 63 (or +54)
02402 *
02403                TEMP1 = ZERO
02404                TEMP2 = ZERO
02405                DO 1470 J = 1, N
02406                   TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
02407                   TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
02408  1470          CONTINUE
02409                RESULT( NTEST ) = TEMP2 / MAX( UNFL,
02410      $                           ULP*MAX( TEMP1, TEMP2 ) )
02411 *
02412  1480          CONTINUE
02413 *
02414 *              8)      Call DSPEVD.
02415 *
02416                CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
02417 *
02418 *              Load array WORK with the upper or lower triangular
02419 *              part of the matrix in packed form.
02420 *
02421                IF( IUPLO.EQ.1 ) THEN
02422                   INDX = 1
02423                   DO 1500 J = 1, N
02424                      DO 1490 I = 1, J
02425                         WORK( INDX ) = A( I, J )
02426                         INDX = INDX + 1
02427  1490                CONTINUE
02428  1500             CONTINUE
02429                ELSE
02430                   INDX = 1
02431                   DO 1520 J = 1, N
02432                      DO 1510 I = J, N
02433                         WORK( INDX ) = A( I, J )
02434                         INDX = INDX + 1
02435  1510                CONTINUE
02436  1520             CONTINUE
02437                END IF
02438 *
02439                NTEST = NTEST + 1
02440                SRNAMT = 'DSPEVD'
02441                CALL DSPEVD( 'V', UPLO, N, WORK, D1, Z, LDU,
02442      $                      WORK( INDX ), LWEDC-INDX+1, IWORK, LIWEDC,
02443      $                      IINFO )
02444                IF( IINFO.NE.0 ) THEN
02445                   WRITE( NOUNIT, FMT = 9999 )'DSPEVD(V,' // UPLO //
02446      $               ')', IINFO, N, JTYPE, IOLDSD
02447                   INFO = ABS( IINFO )
02448                   IF( IINFO.LT.0 ) THEN
02449                      RETURN
02450                   ELSE
02451                      RESULT( NTEST ) = ULPINV
02452                      RESULT( NTEST+1 ) = ULPINV
02453                      RESULT( NTEST+2 ) = ULPINV
02454                      GO TO 1580
02455                   END IF
02456                END IF
02457 *
02458 *              Do tests 64 and 65 (or +54)
02459 *
02460                CALL DSYT21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V,
02461      $                      LDU, TAU, WORK, RESULT( NTEST ) )
02462 *
02463                IF( IUPLO.EQ.1 ) THEN
02464                   INDX = 1
02465                   DO 1540 J = 1, N
02466                      DO 1530 I = 1, J
02467 *
02468                         WORK( INDX ) = A( I, J )
02469                         INDX = INDX + 1
02470  1530                CONTINUE
02471  1540             CONTINUE
02472                ELSE
02473                   INDX = 1
02474                   DO 1560 J = 1, N
02475                      DO 1550 I = J, N
02476                         WORK( INDX ) = A( I, J )
02477                         INDX = INDX + 1
02478  1550                CONTINUE
02479  1560             CONTINUE
02480                END IF
02481 *
02482                NTEST = NTEST + 2
02483                SRNAMT = 'DSPEVD'
02484                CALL DSPEVD( 'N', UPLO, N, WORK, D3, Z, LDU,
02485      $                      WORK( INDX ), LWEDC-INDX+1, IWORK, LIWEDC,
02486      $                      IINFO )
02487                IF( IINFO.NE.0 ) THEN
02488                   WRITE( NOUNIT, FMT = 9999 )'DSPEVD(N,' // UPLO //
02489      $               ')', IINFO, N, JTYPE, IOLDSD
02490                   INFO = ABS( IINFO )
02491                   IF( IINFO.LT.0 ) THEN
02492                      RETURN
02493                   ELSE
02494                      RESULT( NTEST ) = ULPINV
02495                      GO TO 1580
02496                   END IF
02497                END IF
02498 *
02499 *              Do test 66 (or +54)
02500 *
02501                TEMP1 = ZERO
02502                TEMP2 = ZERO
02503                DO 1570 J = 1, N
02504                   TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
02505                   TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
02506  1570          CONTINUE
02507                RESULT( NTEST ) = TEMP2 / MAX( UNFL,
02508      $                           ULP*MAX( TEMP1, TEMP2 ) )
02509  1580          CONTINUE
02510 *
02511 *              9)      Call DSBEVD.
02512 *
02513                IF( JTYPE.LE.7 ) THEN
02514                   KD = 1
02515                ELSE IF( JTYPE.GE.8 .AND. JTYPE.LE.15 ) THEN
02516                   KD = MAX( N-1, 0 )
02517                ELSE
02518                   KD = IHBW
02519                END IF
02520 *
02521 *              Load array V with the upper or lower triangular part
02522 *              of the matrix in band form.
02523 *
02524                IF( IUPLO.EQ.1 ) THEN
02525                   DO 1600 J = 1, N
02526                      DO 1590 I = MAX( 1, J-KD ), J
02527                         V( KD+1+I-J, J ) = A( I, J )
02528  1590                CONTINUE
02529  1600             CONTINUE
02530                ELSE
02531                   DO 1620 J = 1, N
02532                      DO 1610 I = J, MIN( N, J+KD )
02533                         V( 1+I-J, J ) = A( I, J )
02534  1610                CONTINUE
02535  1620             CONTINUE
02536                END IF
02537 *
02538                NTEST = NTEST + 1
02539                SRNAMT = 'DSBEVD'
02540                CALL DSBEVD( 'V', UPLO, N, KD, V, LDU, D1, Z, LDU, WORK,
02541      $                      LWEDC, IWORK, LIWEDC, IINFO )
02542                IF( IINFO.NE.0 ) THEN
02543                   WRITE( NOUNIT, FMT = 9999 )'DSBEVD(V,' // UPLO //
02544      $               ')', IINFO, N, JTYPE, IOLDSD
02545                   INFO = ABS( IINFO )
02546                   IF( IINFO.LT.0 ) THEN
02547                      RETURN
02548                   ELSE
02549                      RESULT( NTEST ) = ULPINV
02550                      RESULT( NTEST+1 ) = ULPINV
02551                      RESULT( NTEST+2 ) = ULPINV
02552                      GO TO 1680
02553                   END IF
02554                END IF
02555 *
02556 *              Do tests 67 and 68 (or +54)
02557 *
02558                CALL DSYT21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V,
02559      $                      LDU, TAU, WORK, RESULT( NTEST ) )
02560 *
02561                IF( IUPLO.EQ.1 ) THEN
02562                   DO 1640 J = 1, N
02563                      DO 1630 I = MAX( 1, J-KD ), J
02564                         V( KD+1+I-J, J ) = A( I, J )
02565  1630                CONTINUE
02566  1640             CONTINUE
02567                ELSE
02568                   DO 1660 J = 1, N
02569                      DO 1650 I = J, MIN( N, J+KD )
02570                         V( 1+I-J, J ) = A( I, J )
02571  1650                CONTINUE
02572  1660             CONTINUE
02573                END IF
02574 *
02575                NTEST = NTEST + 2
02576                SRNAMT = 'DSBEVD'
02577                CALL DSBEVD( 'N', UPLO, N, KD, V, LDU, D3, Z, LDU, WORK,
02578      $                      LWEDC, IWORK, LIWEDC, IINFO )
02579                IF( IINFO.NE.0 ) THEN
02580                   WRITE( NOUNIT, FMT = 9999 )'DSBEVD(N,' // UPLO //
02581      $               ')', IINFO, N, JTYPE, IOLDSD
02582                   INFO = ABS( IINFO )
02583                   IF( IINFO.LT.0 ) THEN
02584                      RETURN
02585                   ELSE
02586                      RESULT( NTEST ) = ULPINV
02587                      GO TO 1680
02588                   END IF
02589                END IF
02590 *
02591 *              Do test 69 (or +54)
02592 *
02593                TEMP1 = ZERO
02594                TEMP2 = ZERO
02595                DO 1670 J = 1, N
02596                   TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
02597                   TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
02598  1670          CONTINUE
02599                RESULT( NTEST ) = TEMP2 / MAX( UNFL,
02600      $                           ULP*MAX( TEMP1, TEMP2 ) )
02601 *
02602  1680          CONTINUE
02603 *
02604 *
02605                CALL DLACPY( ' ', N, N, A, LDA, V, LDU )
02606                NTEST = NTEST + 1
02607                SRNAMT = 'DSYEVR'
02608                CALL DSYEVR( 'V', 'A', UPLO, N, A, LDU, VL, VU, IL, IU,
02609      $                      ABSTOL, M, WA1, Z, LDU, IWORK, WORK, LWORK,
02610      $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
02611                IF( IINFO.NE.0 ) THEN
02612                   WRITE( NOUNIT, FMT = 9999 )'DSYEVR(V,A,' // UPLO //
02613      $               ')', IINFO, N, JTYPE, IOLDSD
02614                   INFO = ABS( IINFO )
02615                   IF( IINFO.LT.0 ) THEN
02616                      RETURN
02617                   ELSE
02618                      RESULT( NTEST ) = ULPINV
02619                      RESULT( NTEST+1 ) = ULPINV
02620                      RESULT( NTEST+2 ) = ULPINV
02621                      GO TO 1700
02622                   END IF
02623                END IF
02624 *
02625 *              Do tests 70 and 71 (or ... )
02626 *
02627                CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
02628 *
02629                CALL DSYT21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V,
02630      $                      LDU, TAU, WORK, RESULT( NTEST ) )
02631 *
02632                NTEST = NTEST + 2
02633                SRNAMT = 'DSYEVR'
02634                CALL DSYEVR( 'N', 'A', UPLO, N, A, LDU, VL, VU, IL, IU,
02635      $                      ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK,
02636      $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
02637                IF( IINFO.NE.0 ) THEN
02638                   WRITE( NOUNIT, FMT = 9999 )'DSYEVR(N,A,' // UPLO //
02639      $               ')', IINFO, N, JTYPE, IOLDSD
02640                   INFO = ABS( IINFO )
02641                   IF( IINFO.LT.0 ) THEN
02642                      RETURN
02643                   ELSE
02644                      RESULT( NTEST ) = ULPINV
02645                      GO TO 1700
02646                   END IF
02647                END IF
02648 *
02649 *              Do test 72 (or ... )
02650 *
02651                TEMP1 = ZERO
02652                TEMP2 = ZERO
02653                DO 1690 J = 1, N
02654                   TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) )
02655                   TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) )
02656  1690          CONTINUE
02657                RESULT( NTEST ) = TEMP2 / MAX( UNFL,
02658      $                           ULP*MAX( TEMP1, TEMP2 ) )
02659 *
02660  1700          CONTINUE
02661 *
02662                NTEST = NTEST + 1
02663                CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
02664                SRNAMT = 'DSYEVR'
02665                CALL DSYEVR( 'V', 'I', UPLO, N, A, LDU, VL, VU, IL, IU,
02666      $                      ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK,
02667      $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
02668                IF( IINFO.NE.0 ) THEN
02669                   WRITE( NOUNIT, FMT = 9999 )'DSYEVR(V,I,' // UPLO //
02670      $               ')', IINFO, N, JTYPE, IOLDSD
02671                   INFO = ABS( IINFO )
02672                   IF( IINFO.LT.0 ) THEN
02673                      RETURN
02674                   ELSE
02675                      RESULT( NTEST ) = ULPINV
02676                      RESULT( NTEST+1 ) = ULPINV
02677                      RESULT( NTEST+2 ) = ULPINV
02678                      GO TO 1710
02679                   END IF
02680                END IF
02681 *
02682 *              Do tests 73 and 74 (or +54)
02683 *
02684                CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
02685 *
02686                CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
02687      $                      V, LDU, TAU, WORK, RESULT( NTEST ) )
02688 *
02689                NTEST = NTEST + 2
02690                CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
02691                SRNAMT = 'DSYEVR'
02692                CALL DSYEVR( 'N', 'I', UPLO, N, A, LDU, VL, VU, IL, IU,
02693      $                      ABSTOL, M3, WA3, Z, LDU, IWORK, WORK, LWORK,
02694      $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
02695                IF( IINFO.NE.0 ) THEN
02696                   WRITE( NOUNIT, FMT = 9999 )'DSYEVR(N,I,' // UPLO //
02697      $               ')', IINFO, N, JTYPE, IOLDSD
02698                   INFO = ABS( IINFO )
02699                   IF( IINFO.LT.0 ) THEN
02700                      RETURN
02701                   ELSE
02702                      RESULT( NTEST ) = ULPINV
02703                      GO TO 1710
02704                   END IF
02705                END IF
02706 *
02707 *              Do test 75 (or +54)
02708 *
02709                TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
02710                TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
02711                RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
02712      $                           MAX( UNFL, ULP*TEMP3 )
02713  1710          CONTINUE
02714 *
02715                NTEST = NTEST + 1
02716                CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
02717                SRNAMT = 'DSYEVR'
02718                CALL DSYEVR( 'V', 'V', UPLO, N, A, LDU, VL, VU, IL, IU,
02719      $                      ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK,
02720      $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
02721                IF( IINFO.NE.0 ) THEN
02722                   WRITE( NOUNIT, FMT = 9999 )'DSYEVR(V,V,' // UPLO //
02723      $               ')', IINFO, N, JTYPE, IOLDSD
02724                   INFO = ABS( IINFO )
02725                   IF( IINFO.LT.0 ) THEN
02726                      RETURN
02727                   ELSE
02728                      RESULT( NTEST ) = ULPINV
02729                      RESULT( NTEST+1 ) = ULPINV
02730                      RESULT( NTEST+2 ) = ULPINV
02731                      GO TO 700
02732                   END IF
02733                END IF
02734 *
02735 *              Do tests 76 and 77 (or +54)
02736 *
02737                CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
02738 *
02739                CALL DSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
02740      $                      V, LDU, TAU, WORK, RESULT( NTEST ) )
02741 *
02742                NTEST = NTEST + 2
02743                CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
02744                SRNAMT = 'DSYEVR'
02745                CALL DSYEVR( 'N', 'V', UPLO, N, A, LDU, VL, VU, IL, IU,
02746      $                      ABSTOL, M3, WA3, Z, LDU, IWORK, WORK, LWORK,
02747      $                      IWORK(2*N+1), LIWORK-2*N, IINFO )
02748                IF( IINFO.NE.0 ) THEN
02749                   WRITE( NOUNIT, FMT = 9999 )'DSYEVR(N,V,' // UPLO //
02750      $               ')', IINFO, N, JTYPE, IOLDSD
02751                   INFO = ABS( IINFO )
02752                   IF( IINFO.LT.0 ) THEN
02753                      RETURN
02754                   ELSE
02755                      RESULT( NTEST ) = ULPINV
02756                      GO TO 700
02757                   END IF
02758                END IF
02759 *
02760                IF( M3.EQ.0 .AND. N.GT.0 ) THEN
02761                   RESULT( NTEST ) = ULPINV
02762                   GO TO 700
02763                END IF
02764 *
02765 *              Do test 78 (or +54)
02766 *
02767                TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
02768                TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
02769                IF( N.GT.0 ) THEN
02770                   TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
02771                ELSE
02772                   TEMP3 = ZERO
02773                END IF
02774                RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
02775      $                           MAX( UNFL, TEMP3*ULP )
02776 *
02777                CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
02778 *
02779  1720       CONTINUE
02780 *
02781 *           End of Loop -- Check for RESULT(j) > THRESH
02782 *
02783             NTESTT = NTESTT + NTEST
02784 *
02785             CALL DLAFTS( 'DST', N, N, JTYPE, NTEST, RESULT, IOLDSD,
02786      $                   THRESH, NOUNIT, NERRS )
02787 *
02788  1730    CONTINUE
02789  1740 CONTINUE
02790 *
02791 *     Summary
02792 *
02793       CALL ALASVM( 'DST', NOUNIT, NERRS, NTESTT, 0 )
02794 *
02795  9999 FORMAT( ' DDRVST: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
02796      $      I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
02797 *
02798       RETURN
02799 *
02800 *     End of DDRVST
02801 *
02802       END