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