LAPACK: TESTING/EIG/cchkst.f Source File

Go to the documentation of this file.
00001       SUBROUTINE CCHKST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
00002      $                   NOUNIT, A, LDA, AP, SD, SE, D1, D2, D3, D4, D5,
00003      $                   WA1, WA2, WA3, WR, U, LDU, V, VP, TAU, Z, WORK,
00004      $                   LWORK, RWORK, LRWORK, IWORK, LIWORK, RESULT,
00005      $                   INFO )
00006       IMPLICIT NONE
00007 *
00008 *  -- LAPACK test routine (version 3.1) --
00009 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00010 *     November 2006
00011 *
00012 *     .. Scalar Arguments ..
00013       INTEGER            INFO, LDA, LDU, LIWORK, LRWORK, LWORK, NOUNIT,
00014      $                   NSIZES, NTYPES
00015       REAL               THRESH
00016 *     ..
00017 *     .. Array Arguments ..
00018       LOGICAL            DOTYPE( * )
00019       INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
00020       REAL               D1( * ), D2( * ), D3( * ), D4( * ), D5( * ),
00021      $                   RESULT( * ), RWORK( * ), SD( * ), SE( * ),
00022      $                   WA1( * ), WA2( * ), WA3( * ), WR( * )
00023       COMPLEX            A( LDA, * ), AP( * ), TAU( * ), U( LDU, * ),
00024      $                   V( LDU, * ), VP( * ), WORK( * ), Z( LDU, * )
00025 *     ..
00026 *
00027 *  Purpose
00028 *  =======
00029 *
00030 *  CCHKST  checks the Hermitian eigenvalue problem routines.
00031 *
00032 *     CHETRD factors A as  U S U* , where * means conjugate transpose,
00033 *     S is real symmetric tridiagonal, and U is unitary.
00034 *     CHETRD can use either just the lower or just the upper triangle
00035 *     of A; CCHKST checks both cases.
00036 *     U is represented as a product of Householder
00037 *     transformations, whose vectors are stored in the first
00038 *     n-1 columns of V, and whose scale factors are in TAU.
00039 *
00040 *     CHPTRD does the same as CHETRD, except that A and V are stored
00041 *     in "packed" format.
00042 *
00043 *     CUNGTR constructs the matrix U from the contents of V and TAU.
00044 *
00045 *     CUPGTR constructs the matrix U from the contents of VP and TAU.
00046 *
00047 *     CSTEQR factors S as  Z D1 Z* , where Z is the unitary
00048 *     matrix of eigenvectors and D1 is a diagonal matrix with
00049 *     the eigenvalues on the diagonal.  D2 is the matrix of
00050 *     eigenvalues computed when Z is not computed.
00051 *
00052 *     SSTERF computes D3, the matrix of eigenvalues, by the
00053 *     PWK method, which does not yield eigenvectors.
00054 *
00055 *     CPTEQR factors S as  Z4 D4 Z4* , for a
00056 *     Hermitian positive definite tridiagonal matrix.
00057 *     D5 is the matrix of eigenvalues computed when Z is not
00058 *     computed.
00059 *
00060 *     SSTEBZ computes selected eigenvalues.  WA1, WA2, and
00061 *     WA3 will denote eigenvalues computed to high
00062 *     absolute accuracy, with different range options.
00063 *     WR will denote eigenvalues computed to high relative
00064 *     accuracy.
00065 *
00066 *     CSTEIN computes Y, the eigenvectors of S, given the
00067 *     eigenvalues.
00068 *
00069 *     CSTEDC factors S as Z D1 Z* , where Z is the unitary
00070 *     matrix of eigenvectors and D1 is a diagonal matrix with
00071 *     the eigenvalues on the diagonal ('I' option). It may also
00072 *     update an input unitary matrix, usually the output
00073 *     from CHETRD/CUNGTR or CHPTRD/CUPGTR ('V' option). It may
00074 *     also just compute eigenvalues ('N' option).
00075 *
00076 *     CSTEMR factors S as Z D1 Z* , where Z is the unitary
00077 *     matrix of eigenvectors and D1 is a diagonal matrix with
00078 *     the eigenvalues on the diagonal ('I' option).  CSTEMR
00079 *     uses the Relatively Robust Representation whenever possible.
00080 *
00081 *  When CCHKST is called, a number of matrix "sizes" ("n's") and a
00082 *  number of matrix "types" are specified.  For each size ("n")
00083 *  and each type of matrix, one matrix will be generated and used
00084 *  to test the Hermitian eigenroutines.  For each matrix, a number
00085 *  of tests will be performed:
00086 *
00087 *  (1)     | A - V S V* | / ( |A| n ulp ) CHETRD( UPLO='U', ... )
00088 *
00089 *  (2)     | I - UV* | / ( n ulp )        CUNGTR( UPLO='U', ... )
00090 *
00091 *  (3)     | A - V S V* | / ( |A| n ulp ) CHETRD( UPLO='L', ... )
00092 *
00093 *  (4)     | I - UV* | / ( n ulp )        CUNGTR( UPLO='L', ... )
00094 *
00095 *  (5-8)   Same as 1-4, but for CHPTRD and CUPGTR.
00096 *
00097 *  (9)     | S - Z D Z* | / ( |S| n ulp ) CSTEQR('V',...)
00098 *
00099 *  (10)    | I - ZZ* | / ( n ulp )        CSTEQR('V',...)
00100 *
00101 *  (11)    | D1 - D2 | / ( |D1| ulp )        CSTEQR('N',...)
00102 *
00103 *  (12)    | D1 - D3 | / ( |D1| ulp )        SSTERF
00104 *
00105 *  (13)    0 if the true eigenvalues (computed by sturm count)
00106 *          of S are within THRESH of
00107 *          those in D1.  2*THRESH if they are not.  (Tested using
00108 *          SSTECH)
00109 *
00110 *  For S positive definite,
00111 *
00112 *  (14)    | S - Z4 D4 Z4* | / ( |S| n ulp ) CPTEQR('V',...)
00113 *
00114 *  (15)    | I - Z4 Z4* | / ( n ulp )        CPTEQR('V',...)
00115 *
00116 *  (16)    | D4 - D5 | / ( 100 |D4| ulp )       CPTEQR('N',...)
00117 *
00118 *  When S is also diagonally dominant by the factor gamma < 1,
00119 *
00120 *  (17)    max | D4(i) - WR(i) | / ( |D4(i)| omega ) ,
00121 *           i
00122 *          omega = 2 (2n-1) ULP (1 + 8 gamma**2) / (1 - gamma)**4
00123 *                                               SSTEBZ( 'A', 'E', ...)
00124 *
00125 *  (18)    | WA1 - D3 | / ( |D3| ulp )          SSTEBZ( 'A', 'E', ...)
00126 *
00127 *  (19)    ( max { min | WA2(i)-WA3(j) | } +
00128 *             i     j
00129 *            max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
00130 *             i     j
00131 *                                               SSTEBZ( 'I', 'E', ...)
00132 *
00133 *  (20)    | S - Y WA1 Y* | / ( |S| n ulp )  SSTEBZ, CSTEIN
00134 *
00135 *  (21)    | I - Y Y* | / ( n ulp )          SSTEBZ, CSTEIN
00136 *
00137 *  (22)    | S - Z D Z* | / ( |S| n ulp )    CSTEDC('I')
00138 *
00139 *  (23)    | I - ZZ* | / ( n ulp )           CSTEDC('I')
00140 *
00141 *  (24)    | S - Z D Z* | / ( |S| n ulp )    CSTEDC('V')
00142 *
00143 *  (25)    | I - ZZ* | / ( n ulp )           CSTEDC('V')
00144 *
00145 *  (26)    | D1 - D2 | / ( |D1| ulp )           CSTEDC('V') and
00146 *                                               CSTEDC('N')
00147 *
00148 *  Test 27 is disabled at the moment because CSTEMR does not
00149 *  guarantee high relatvie accuracy.
00150 *
00151 *  (27)    max | D6(i) - WR(i) | / ( |D6(i)| omega ) ,
00152 *           i
00153 *          omega = 2 (2n-1) ULP (1 + 8 gamma**2) / (1 - gamma)**4
00154 *                                               CSTEMR('V', 'A')
00155 *
00156 *  (28)    max | D6(i) - WR(i) | / ( |D6(i)| omega ) ,
00157 *           i
00158 *          omega = 2 (2n-1) ULP (1 + 8 gamma**2) / (1 - gamma)**4
00159 *                                               CSTEMR('V', 'I')
00160 *
00161 *  Tests 29 through 34 are disable at present because CSTEMR
00162 *  does not handle partial specturm requests.
00163 *
00164 *  (29)    | S - Z D Z* | / ( |S| n ulp )    CSTEMR('V', 'I')
00165 *
00166 *  (30)    | I - ZZ* | / ( n ulp )           CSTEMR('V', 'I')
00167 *
00168 *  (31)    ( max { min | WA2(i)-WA3(j) | } +
00169 *             i     j
00170 *            max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
00171 *             i     j
00172 *          CSTEMR('N', 'I') vs. CSTEMR('V', 'I')
00173 *
00174 *  (32)    | S - Z D Z* | / ( |S| n ulp )    CSTEMR('V', 'V')
00175 *
00176 *  (33)    | I - ZZ* | / ( n ulp )           CSTEMR('V', 'V')
00177 *
00178 *  (34)    ( max { min | WA2(i)-WA3(j) | } +
00179 *             i     j
00180 *            max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
00181 *             i     j
00182 *          CSTEMR('N', 'V') vs. CSTEMR('V', 'V')
00183 *
00184 *  (35)    | S - Z D Z* | / ( |S| n ulp )    CSTEMR('V', 'A')
00185 *
00186 *  (36)    | I - ZZ* | / ( n ulp )           CSTEMR('V', 'A')
00187 *
00188 *  (37)    ( max { min | WA2(i)-WA3(j) | } +
00189 *             i     j
00190 *            max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
00191 *             i     j
00192 *          CSTEMR('N', 'A') vs. CSTEMR('V', 'A')
00193 *
00194 *  The "sizes" are specified by an array NN(1:NSIZES); the value of
00195 *  each element NN(j) specifies one size.
00196 *  The "types" are specified by a logical array DOTYPE( 1:NTYPES );
00197 *  if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
00198 *  Currently, the list of possible types is:
00199 *
00200 *  (1)  The zero matrix.
00201 *  (2)  The identity matrix.
00202 *
00203 *  (3)  A diagonal matrix with evenly spaced entries
00204 *       1, ..., ULP  and random signs.
00205 *       (ULP = (first number larger than 1) - 1 )
00206 *  (4)  A diagonal matrix with geometrically spaced entries
00207 *       1, ..., ULP  and random signs.
00208 *  (5)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
00209 *       and random signs.
00210 *
00211 *  (6)  Same as (4), but multiplied by SQRT( overflow threshold )
00212 *  (7)  Same as (4), but multiplied by SQRT( underflow threshold )
00213 *
00214 *  (8)  A matrix of the form  U* D U, where U is unitary and
00215 *       D has evenly spaced entries 1, ..., ULP with random signs
00216 *       on the diagonal.
00217 *
00218 *  (9)  A matrix of the form  U* D U, where U is unitary and
00219 *       D has geometrically spaced entries 1, ..., ULP with random
00220 *       signs on the diagonal.
00221 *
00222 *  (10) A matrix of the form  U* D U, where U is unitary and
00223 *       D has "clustered" entries 1, ULP,..., ULP with random
00224 *       signs on the diagonal.
00225 *
00226 *  (11) Same as (8), but multiplied by SQRT( overflow threshold )
00227 *  (12) Same as (8), but multiplied by SQRT( underflow threshold )
00228 *
00229 *  (13) Hermitian matrix with random entries chosen from (-1,1).
00230 *  (14) Same as (13), but multiplied by SQRT( overflow threshold )
00231 *  (15) Same as (13), but multiplied by SQRT( underflow threshold )
00232 *  (16) Same as (8), but diagonal elements are all positive.
00233 *  (17) Same as (9), but diagonal elements are all positive.
00234 *  (18) Same as (10), but diagonal elements are all positive.
00235 *  (19) Same as (16), but multiplied by SQRT( overflow threshold )
00236 *  (20) Same as (16), but multiplied by SQRT( underflow threshold )
00237 *  (21) A diagonally dominant tridiagonal matrix with geometrically
00238 *       spaced diagonal entries 1, ..., ULP.
00239 *
00240 *  Arguments
00241 *  =========
00242 *
00243 *  NSIZES  (input) INTEGER
00244 *          The number of sizes of matrices to use.  If it is zero,
00245 *          CCHKST does nothing.  It must be at least zero.
00246 *
00247 *  NN      (input) INTEGER array, dimension (NSIZES)
00248 *          An array containing the sizes to be used for the matrices.
00249 *          Zero values will be skipped.  The values must be at least
00250 *          zero.
00251 *
00252 *  NTYPES  (input) INTEGER
00253 *          The number of elements in DOTYPE.   If it is zero, CCHKST
00254 *          does nothing.  It must be at least zero.  If it is MAXTYP+1
00255 *          and NSIZES is 1, then an additional type, MAXTYP+1 is
00256 *          defined, which is to use whatever matrix is in A.  This
00257 *          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
00258 *          DOTYPE(MAXTYP+1) is .TRUE. .
00259 *
00260 *  DOTYPE  (input) LOGICAL array, dimension (NTYPES)
00261 *          If DOTYPE(j) is .TRUE., then for each size in NN a
00262 *          matrix of that size and of type j will be generated.
00263 *          If NTYPES is smaller than the maximum number of types
00264 *          defined (PARAMETER MAXTYP), then types NTYPES+1 through
00265 *          MAXTYP will not be generated.  If NTYPES is larger
00266 *          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
00267 *          will be ignored.
00268 *
00269 *  ISEED   (input/output) INTEGER array, dimension (4)
00270 *          On entry ISEED specifies the seed of the random number
00271 *          generator. The array elements should be between 0 and 4095;
00272 *          if not they will be reduced mod 4096.  Also, ISEED(4) must
00273 *          be odd.  The random number generator uses a linear
00274 *          congruential sequence limited to small integers, and so
00275 *          should produce machine independent random numbers. The
00276 *          values of ISEED are changed on exit, and can be used in the
00277 *          next call to CCHKST to continue the same random number
00278 *          sequence.
00279 *
00280 *  THRESH  (input) REAL
00281 *          A test will count as "failed" if the "error", computed as
00282 *          described above, exceeds THRESH.  Note that the error
00283 *          is scaled to be O(1), so THRESH should be a reasonably
00284 *          small multiple of 1, e.g., 10 or 100.  In particular,
00285 *          it should not depend on the precision (single vs. double)
00286 *          or the size of the matrix.  It must be at least zero.
00287 *
00288 *  NOUNIT  (input) INTEGER
00289 *          The FORTRAN unit number for printing out error messages
00290 *          (e.g., if a routine returns IINFO not equal to 0.)
00291 *
00292 *  A       (input/workspace/output) COMPLEX array of
00293 *                                  dimension ( LDA , max(NN) )
00294 *          Used to hold the matrix whose eigenvalues are to be
00295 *          computed.  On exit, A contains the last matrix actually
00296 *          used.
00297 *
00298 *  LDA     (input) INTEGER
00299 *          The leading dimension of A.  It must be at
00300 *          least 1 and at least max( NN ).
00301 *
00302 *  AP      (workspace) COMPLEX array of
00303 *                      dimension( max(NN)*max(NN+1)/2 )
00304 *          The matrix A stored in packed format.
00305 *
00306 *  SD      (workspace/output) REAL array of
00307 *                             dimension( max(NN) )
00308 *          The diagonal of the tridiagonal matrix computed by CHETRD.
00309 *          On exit, SD and SE contain the tridiagonal form of the
00310 *          matrix in A.
00311 *
00312 *  SE      (workspace/output) REAL array of
00313 *                             dimension( max(NN) )
00314 *          The off-diagonal of the tridiagonal matrix computed by
00315 *          CHETRD.  On exit, SD and SE contain the tridiagonal form of
00316 *          the matrix in A.
00317 *
00318 *  D1      (workspace/output) REAL array of
00319 *                             dimension( max(NN) )
00320 *          The eigenvalues of A, as computed by CSTEQR simlutaneously
00321 *          with Z.  On exit, the eigenvalues in D1 correspond with the
00322 *          matrix in A.
00323 *
00324 *  D2      (workspace/output) REAL array of
00325 *                             dimension( max(NN) )
00326 *          The eigenvalues of A, as computed by CSTEQR if Z is not
00327 *          computed.  On exit, the eigenvalues in D2 correspond with
00328 *          the matrix in A.
00329 *
00330 *  D3      (workspace/output) REAL array of
00331 *                             dimension( max(NN) )
00332 *          The eigenvalues of A, as computed by SSTERF.  On exit, the
00333 *          eigenvalues in D3 correspond with the matrix in A.
00334 *
00335 *  U       (workspace/output) COMPLEX array of
00336 *                             dimension( LDU, max(NN) ).
00337 *          The unitary matrix computed by CHETRD + CUNGTR.
00338 *
00339 *  LDU     (input) INTEGER
00340 *          The leading dimension of U, Z, and V.  It must be at least 1
00341 *          and at least max( NN ).
00342 *
00343 *  V       (workspace/output) COMPLEX array of
00344 *                             dimension( LDU, max(NN) ).
00345 *          The Housholder vectors computed by CHETRD in reducing A to
00346 *          tridiagonal form.  The vectors computed with UPLO='U' are
00347 *          in the upper triangle, and the vectors computed with UPLO='L'
00348 *          are in the lower triangle.  (As described in CHETRD, the
00349 *          sub- and superdiagonal are not set to 1, although the
00350 *          true Householder vector has a 1 in that position.  The
00351 *          routines that use V, such as CUNGTR, set those entries to
00352 *          1 before using them, and then restore them later.)
00353 *
00354 *  VP      (workspace) COMPLEX array of
00355 *                      dimension( max(NN)*max(NN+1)/2 )
00356 *          The matrix V stored in packed format.
00357 *
00358 *  TAU     (workspace/output) COMPLEX array of
00359 *                             dimension( max(NN) )
00360 *          The Householder factors computed by CHETRD in reducing A
00361 *          to tridiagonal form.
00362 *
00363 *  Z       (workspace/output) COMPLEX array of
00364 *                             dimension( LDU, max(NN) ).
00365 *          The unitary matrix of eigenvectors computed by CSTEQR,
00366 *          CPTEQR, and CSTEIN.
00367 *
00368 *  WORK    (workspace/output) COMPLEX array of
00369 *                      dimension( LWORK )
00370 *
00371 *  LWORK   (input) INTEGER
00372 *          The number of entries in WORK.  This must be at least
00373 *          1 + 4 * Nmax + 2 * Nmax * lg Nmax + 3 * Nmax**2
00374 *          where Nmax = max( NN(j), 2 ) and lg = log base 2.
00375 *
00376 *  IWORK   (workspace/output) INTEGER array,
00377 *             dimension (6 + 6*Nmax + 5 * Nmax * lg Nmax )
00378 *          where Nmax = max( NN(j), 2 ) and lg = log base 2.
00379 *          Workspace.
00380 *
00381 *  RWORK   (workspace/output) REAL array of
00382 *                      dimension( ??? )
00383 *
00384 *  RESULT  (output) REAL array, dimension (26)
00385 *          The values computed by the tests described above.
00386 *          The values are currently limited to 1/ulp, to avoid
00387 *          overflow.
00388 *
00389 *  INFO    (output) INTEGER
00390 *          If 0, then everything ran OK.
00391 *           -1: NSIZES < 0
00392 *           -2: Some NN(j) < 0
00393 *           -3: NTYPES < 0
00394 *           -5: THRESH < 0
00395 *           -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
00396 *          -23: LDU < 1 or LDU < NMAX.
00397 *          -29: LWORK too small.
00398 *          If  CLATMR, CLATMS, CHETRD, CUNGTR, CSTEQR, SSTERF,
00399 *              or CUNMC2 returns an error code, the
00400 *              absolute value of it is returned.
00401 *
00402 *-----------------------------------------------------------------------
00403 *
00404 *       Some Local Variables and Parameters:
00405 *       ---- ----- --------- --- ----------
00406 *       ZERO, ONE       Real 0 and 1.
00407 *       MAXTYP          The number of types defined.
00408 *       NTEST           The number of tests performed, or which can
00409 *                       be performed so far, for the current matrix.
00410 *       NTESTT          The total number of tests performed so far.
00411 *       NBLOCK          Blocksize as returned by ENVIR.
00412 *       NMAX            Largest value in NN.
00413 *       NMATS           The number of matrices generated so far.
00414 *       NERRS           The number of tests which have exceeded THRESH
00415 *                       so far.
00416 *       COND, IMODE     Values to be passed to the matrix generators.
00417 *       ANORM           Norm of A; passed to matrix generators.
00418 *
00419 *       OVFL, UNFL      Overflow and underflow thresholds.
00420 *       ULP, ULPINV     Finest relative precision and its inverse.
00421 *       RTOVFL, RTUNFL  Square roots of the previous 2 values.
00422 *               The following four arrays decode JTYPE:
00423 *       KTYPE(j)        The general type (1-10) for type "j".
00424 *       KMODE(j)        The MODE value to be passed to the matrix
00425 *                       generator for type "j".
00426 *       KMAGN(j)        The order of magnitude ( O(1),
00427 *                       O(overflow^(1/2) ), O(underflow^(1/2) )
00428 *
00429 *  =====================================================================
00430 *
00431 *     .. Parameters ..
00432       REAL               ZERO, ONE, TWO, EIGHT, TEN, HUN
00433       PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0,
00434      $                   EIGHT = 8.0E0, TEN = 10.0E0, HUN = 100.0E0 )
00435       COMPLEX            CZERO, CONE
00436       PARAMETER          ( CZERO = ( 0.0E+0, 0.0E+0 ),
00437      $                   CONE = ( 1.0E+0, 0.0E+0 ) )
00438       REAL               HALF
00439       PARAMETER          ( HALF = ONE / TWO )
00440       INTEGER            MAXTYP
00441       PARAMETER          ( MAXTYP = 21 )
00442       LOGICAL            CRANGE
00443       PARAMETER          ( CRANGE = .FALSE. )
00444       LOGICAL            CREL
00445       PARAMETER          ( CREL = .FALSE. )
00446 *     ..
00447 *     .. Local Scalars ..
00448       LOGICAL            BADNN, TRYRAC
00449       INTEGER            I, IINFO, IL, IMODE, INDE, INDRWK, ITEMP,
00450      $                   ITYPE, IU, J, JC, JR, JSIZE, JTYPE, LGN,
00451      $                   LIWEDC, LOG2UI, LRWEDC, LWEDC, M, M2, M3,
00452      $                   MTYPES, N, NAP, NBLOCK, NERRS, NMATS, NMAX,
00453      $                   NSPLIT, NTEST, NTESTT
00454       REAL               ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
00455      $                   RTUNFL, TEMP1, TEMP2, TEMP3, TEMP4, ULP,
00456      $                   ULPINV, UNFL, VL, VU
00457 *     ..
00458 *     .. Local Arrays ..
00459       INTEGER            IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
00460      $                   KMAGN( MAXTYP ), KMODE( MAXTYP ),
00461      $                   KTYPE( MAXTYP )
00462       REAL               DUMMA( 1 )
00463 *     ..
00464 *     .. External Functions ..
00465       INTEGER            ILAENV
00466       REAL               SLAMCH, SLARND, SSXT1
00467       EXTERNAL           ILAENV, SLAMCH, SLARND, SSXT1
00468 *     ..
00469 *     .. External Subroutines ..
00470       EXTERNAL           CCOPY, CHET21, CHETRD, CHPT21, CHPTRD, CLACPY,
00471      $                   CLASET, CLATMR, CLATMS, CPTEQR, CSTEDC, CSTEMR,
00472      $                   CSTEIN, CSTEQR, CSTT21, CSTT22, CUNGTR, CUPGTR,
00473      $                   SCOPY, SLABAD, SLASUM, SSTEBZ, SSTECH, SSTERF,
00474      $                   XERBLA
00475 *     ..
00476 *     .. Intrinsic Functions ..
00477       INTRINSIC          ABS, CONJG, INT, LOG, MAX, MIN, REAL, SQRT
00478 *     ..
00479 *     .. Data statements ..
00480       DATA               KTYPE / 1, 2, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 8,
00481      $                   8, 8, 9, 9, 9, 9, 9, 10 /
00482       DATA               KMAGN / 1, 1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
00483      $                   2, 3, 1, 1, 1, 2, 3, 1 /
00484       DATA               KMODE / 0, 0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
00485      $                   0, 0, 4, 3, 1, 4, 4, 3 /
00486 *     ..
00487 *     .. Executable Statements ..
00488 *
00489 *     Keep ftnchek happy
00490       IDUMMA( 1 ) = 1
00491 *
00492 *     Check for errors
00493 *
00494       NTESTT = 0
00495       INFO = 0
00496 *
00497 *     Important constants
00498 *
00499       BADNN = .FALSE.
00500       TRYRAC = .TRUE.
00501       NMAX = 1
00502       DO 10 J = 1, NSIZES
00503          NMAX = MAX( NMAX, NN( J ) )
00504          IF( NN( J ).LT.0 )
00505      $      BADNN = .TRUE.
00506    10 CONTINUE
00507 *
00508       NBLOCK = ILAENV( 1, 'CHETRD', 'L', NMAX, -1, -1, -1 )
00509       NBLOCK = MIN( NMAX, MAX( 1, NBLOCK ) )
00510 *
00511 *     Check for errors
00512 *
00513       IF( NSIZES.LT.0 ) THEN
00514          INFO = -1
00515       ELSE IF( BADNN ) THEN
00516          INFO = -2
00517       ELSE IF( NTYPES.LT.0 ) THEN
00518          INFO = -3
00519       ELSE IF( LDA.LT.NMAX ) THEN
00520          INFO = -9
00521       ELSE IF( LDU.LT.NMAX ) THEN
00522          INFO = -23
00523       ELSE IF( 2*MAX( 2, NMAX )**2.GT.LWORK ) THEN
00524          INFO = -29
00525       END IF
00526 *
00527       IF( INFO.NE.0 ) THEN
00528          CALL XERBLA( 'CCHKST', -INFO )
00529          RETURN
00530       END IF
00531 *
00532 *     Quick return if possible
00533 *
00534       IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 )
00535      $   RETURN
00536 *
00537 *     More Important constants
00538 *
00539       UNFL = SLAMCH( 'Safe minimum' )
00540       OVFL = ONE / UNFL
00541       CALL SLABAD( UNFL, OVFL )
00542       ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' )
00543       ULPINV = ONE / ULP
00544       LOG2UI = INT( LOG( ULPINV ) / LOG( TWO ) )
00545       RTUNFL = SQRT( UNFL )
00546       RTOVFL = SQRT( OVFL )
00547 *
00548 *     Loop over sizes, types
00549 *
00550       DO 20 I = 1, 4
00551          ISEED2( I ) = ISEED( I )
00552    20 CONTINUE
00553       NERRS = 0
00554       NMATS = 0
00555 *
00556       DO 310 JSIZE = 1, NSIZES
00557          N = NN( JSIZE )
00558          IF( N.GT.0 ) THEN
00559             LGN = INT( LOG( REAL( N ) ) / LOG( TWO ) )
00560             IF( 2**LGN.LT.N )
00561      $         LGN = LGN + 1
00562             IF( 2**LGN.LT.N )
00563      $         LGN = LGN + 1
00564             LWEDC = 1 + 4*N + 2*N*LGN + 3*N**2
00565             LRWEDC = 1 + 3*N + 2*N*LGN + 3*N**2
00566             LIWEDC = 6 + 6*N + 5*N*LGN
00567          ELSE
00568             LWEDC = 8
00569             LRWEDC = 7
00570             LIWEDC = 12
00571          END IF
00572          NAP = ( N*( N+1 ) ) / 2
00573          ANINV = ONE / REAL( MAX( 1, N ) )
00574 *
00575          IF( NSIZES.NE.1 ) THEN
00576             MTYPES = MIN( MAXTYP, NTYPES )
00577          ELSE
00578             MTYPES = MIN( MAXTYP+1, NTYPES )
00579          END IF
00580 *
00581          DO 300 JTYPE = 1, MTYPES
00582             IF( .NOT.DOTYPE( JTYPE ) )
00583      $         GO TO 300
00584             NMATS = NMATS + 1
00585             NTEST = 0
00586 *
00587             DO 30 J = 1, 4
00588                IOLDSD( J ) = ISEED( J )
00589    30       CONTINUE
00590 *
00591 *           Compute "A"
00592 *
00593 *           Control parameters:
00594 *
00595 *               KMAGN  KMODE        KTYPE
00596 *           =1  O(1)   clustered 1  zero
00597 *           =2  large  clustered 2  identity
00598 *           =3  small  exponential  (none)
00599 *           =4         arithmetic   diagonal, (w/ eigenvalues)
00600 *           =5         random log   Hermitian, w/ eigenvalues
00601 *           =6         random       (none)
00602 *           =7                      random diagonal
00603 *           =8                      random Hermitian
00604 *           =9                      positive definite
00605 *           =10                     diagonally dominant tridiagonal
00606 *
00607             IF( MTYPES.GT.MAXTYP )
00608      $         GO TO 100
00609 *
00610             ITYPE = KTYPE( JTYPE )
00611             IMODE = KMODE( JTYPE )
00612 *
00613 *           Compute norm
00614 *
00615             GO TO ( 40, 50, 60 )KMAGN( JTYPE )
00616 *
00617    40       CONTINUE
00618             ANORM = ONE
00619             GO TO 70
00620 *
00621    50       CONTINUE
00622             ANORM = ( RTOVFL*ULP )*ANINV
00623             GO TO 70
00624 *
00625    60       CONTINUE
00626             ANORM = RTUNFL*N*ULPINV
00627             GO TO 70
00628 *
00629    70       CONTINUE
00630 *
00631             CALL CLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
00632             IINFO = 0
00633             IF( JTYPE.LE.15 ) THEN
00634                COND = ULPINV
00635             ELSE
00636                COND = ULPINV*ANINV / TEN
00637             END IF
00638 *
00639 *           Special Matrices -- Identity & Jordan block
00640 *
00641 *              Zero
00642 *
00643             IF( ITYPE.EQ.1 ) THEN
00644                IINFO = 0
00645 *
00646             ELSE IF( ITYPE.EQ.2 ) THEN
00647 *
00648 *              Identity
00649 *
00650                DO 80 JC = 1, N
00651                   A( JC, JC ) = ANORM
00652    80          CONTINUE
00653 *
00654             ELSE IF( ITYPE.EQ.4 ) THEN
00655 *
00656 *              Diagonal Matrix, [Eigen]values Specified
00657 *
00658                CALL CLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
00659      $                      ANORM, 0, 0, 'N', A, LDA, WORK, IINFO )
00660 *
00661 *
00662             ELSE IF( ITYPE.EQ.5 ) THEN
00663 *
00664 *              Hermitian, eigenvalues specified
00665 *
00666                CALL CLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
00667      $                      ANORM, N, N, 'N', A, LDA, WORK, IINFO )
00668 *
00669             ELSE IF( ITYPE.EQ.7 ) THEN
00670 *
00671 *              Diagonal, random eigenvalues
00672 *
00673                CALL CLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE,
00674      $                      'T', 'N', WORK( N+1 ), 1, ONE,
00675      $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
00676      $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
00677 *
00678             ELSE IF( ITYPE.EQ.8 ) THEN
00679 *
00680 *              Hermitian, random eigenvalues
00681 *
00682                CALL CLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE,
00683      $                      'T', 'N', WORK( N+1 ), 1, ONE,
00684      $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N,
00685      $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
00686 *
00687             ELSE IF( ITYPE.EQ.9 ) THEN
00688 *
00689 *              Positive definite, eigenvalues specified.
00690 *
00691                CALL CLATMS( N, N, 'S', ISEED, 'P', RWORK, IMODE, COND,
00692      $                      ANORM, N, N, 'N', A, LDA, WORK, IINFO )
00693 *
00694             ELSE IF( ITYPE.EQ.10 ) THEN
00695 *
00696 *              Positive definite tridiagonal, eigenvalues specified.
00697 *
00698                CALL CLATMS( N, N, 'S', ISEED, 'P', RWORK, IMODE, COND,
00699      $                      ANORM, 1, 1, 'N', A, LDA, WORK, IINFO )
00700                DO 90 I = 2, N
00701                   TEMP1 = ABS( A( I-1, I ) )
00702                   TEMP2 = SQRT( ABS( A( I-1, I-1 )*A( I, I ) ) )
00703                   IF( TEMP1.GT.HALF*TEMP2 ) THEN
00704                      A( I-1, I ) = A( I-1, I )*
00705      $                             ( HALF*TEMP2 / ( UNFL+TEMP1 ) )
00706                      A( I, I-1 ) = CONJG( A( I-1, I ) )
00707                   END IF
00708    90          CONTINUE
00709 *
00710             ELSE
00711 *
00712                IINFO = 1
00713             END IF
00714 *
00715             IF( IINFO.NE.0 ) THEN
00716                WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE,
00717      $            IOLDSD
00718                INFO = ABS( IINFO )
00719                RETURN
00720             END IF
00721 *
00722   100       CONTINUE
00723 *
00724 *           Call CHETRD and CUNGTR to compute S and U from
00725 *           upper triangle.
00726 *
00727             CALL CLACPY( 'U', N, N, A, LDA, V, LDU )
00728 *
00729             NTEST = 1
00730             CALL CHETRD( 'U', N, V, LDU, SD, SE, TAU, WORK, LWORK,
00731      $                   IINFO )
00732 *
00733             IF( IINFO.NE.0 ) THEN
00734                WRITE( NOUNIT, FMT = 9999 )'CHETRD(U)', IINFO, N, JTYPE,
00735      $            IOLDSD
00736                INFO = ABS( IINFO )
00737                IF( IINFO.LT.0 ) THEN
00738                   RETURN
00739                ELSE
00740                   RESULT( 1 ) = ULPINV
00741                   GO TO 280
00742                END IF
00743             END IF
00744 *
00745             CALL CLACPY( 'U', N, N, V, LDU, U, LDU )
00746 *
00747             NTEST = 2
00748             CALL CUNGTR( 'U', N, U, LDU, TAU, WORK, LWORK, IINFO )
00749             IF( IINFO.NE.0 ) THEN
00750                WRITE( NOUNIT, FMT = 9999 )'CUNGTR(U)', IINFO, N, JTYPE,
00751      $            IOLDSD
00752                INFO = ABS( IINFO )
00753                IF( IINFO.LT.0 ) THEN
00754                   RETURN
00755                ELSE
00756                   RESULT( 2 ) = ULPINV
00757                   GO TO 280
00758                END IF
00759             END IF
00760 *
00761 *           Do tests 1 and 2
00762 *
00763             CALL CHET21( 2, 'Upper', N, 1, A, LDA, SD, SE, U, LDU, V,
00764      $                   LDU, TAU, WORK, RWORK, RESULT( 1 ) )
00765             CALL CHET21( 3, 'Upper', N, 1, A, LDA, SD, SE, U, LDU, V,
00766      $                   LDU, TAU, WORK, RWORK, RESULT( 2 ) )
00767 *
00768 *           Call CHETRD and CUNGTR to compute S and U from
00769 *           lower triangle, do tests.
00770 *
00771             CALL CLACPY( 'L', N, N, A, LDA, V, LDU )
00772 *
00773             NTEST = 3
00774             CALL CHETRD( 'L', N, V, LDU, SD, SE, TAU, WORK, LWORK,
00775      $                   IINFO )
00776 *
00777             IF( IINFO.NE.0 ) THEN
00778                WRITE( NOUNIT, FMT = 9999 )'CHETRD(L)', IINFO, N, JTYPE,
00779      $            IOLDSD
00780                INFO = ABS( IINFO )
00781                IF( IINFO.LT.0 ) THEN
00782                   RETURN
00783                ELSE
00784                   RESULT( 3 ) = ULPINV
00785                   GO TO 280
00786                END IF
00787             END IF
00788 *
00789             CALL CLACPY( 'L', N, N, V, LDU, U, LDU )
00790 *
00791             NTEST = 4
00792             CALL CUNGTR( 'L', N, U, LDU, TAU, WORK, LWORK, IINFO )
00793             IF( IINFO.NE.0 ) THEN
00794                WRITE( NOUNIT, FMT = 9999 )'CUNGTR(L)', IINFO, N, JTYPE,
00795      $            IOLDSD
00796                INFO = ABS( IINFO )
00797                IF( IINFO.LT.0 ) THEN
00798                   RETURN
00799                ELSE
00800                   RESULT( 4 ) = ULPINV
00801                   GO TO 280
00802                END IF
00803             END IF
00804 *
00805             CALL CHET21( 2, 'Lower', N, 1, A, LDA, SD, SE, U, LDU, V,
00806      $                   LDU, TAU, WORK, RWORK, RESULT( 3 ) )
00807             CALL CHET21( 3, 'Lower', N, 1, A, LDA, SD, SE, U, LDU, V,
00808      $                   LDU, TAU, WORK, RWORK, RESULT( 4 ) )
00809 *
00810 *           Store the upper triangle of A in AP
00811 *
00812             I = 0
00813             DO 120 JC = 1, N
00814                DO 110 JR = 1, JC
00815                   I = I + 1
00816                   AP( I ) = A( JR, JC )
00817   110          CONTINUE
00818   120       CONTINUE
00819 *
00820 *           Call CHPTRD and CUPGTR to compute S and U from AP
00821 *
00822             CALL CCOPY( NAP, AP, 1, VP, 1 )
00823 *
00824             NTEST = 5
00825             CALL CHPTRD( 'U', N, VP, SD, SE, TAU, IINFO )
00826 *
00827             IF( IINFO.NE.0 ) THEN
00828                WRITE( NOUNIT, FMT = 9999 )'CHPTRD(U)', IINFO, N, JTYPE,
00829      $            IOLDSD
00830                INFO = ABS( IINFO )
00831                IF( IINFO.LT.0 ) THEN
00832                   RETURN
00833                ELSE
00834                   RESULT( 5 ) = ULPINV
00835                   GO TO 280
00836                END IF
00837             END IF
00838 *
00839             NTEST = 6
00840             CALL CUPGTR( 'U', N, VP, TAU, U, LDU, WORK, IINFO )
00841             IF( IINFO.NE.0 ) THEN
00842                WRITE( NOUNIT, FMT = 9999 )'CUPGTR(U)', IINFO, N, JTYPE,
00843      $            IOLDSD
00844                INFO = ABS( IINFO )
00845                IF( IINFO.LT.0 ) THEN
00846                   RETURN
00847                ELSE
00848                   RESULT( 6 ) = ULPINV
00849                   GO TO 280
00850                END IF
00851             END IF
00852 *
00853 *           Do tests 5 and 6
00854 *
00855             CALL CHPT21( 2, 'Upper', N, 1, AP, SD, SE, U, LDU, VP, TAU,
00856      $                   WORK, RWORK, RESULT( 5 ) )
00857             CALL CHPT21( 3, 'Upper', N, 1, AP, SD, SE, U, LDU, VP, TAU,
00858      $                   WORK, RWORK, RESULT( 6 ) )
00859 *
00860 *           Store the lower triangle of A in AP
00861 *
00862             I = 0
00863             DO 140 JC = 1, N
00864                DO 130 JR = JC, N
00865                   I = I + 1
00866                   AP( I ) = A( JR, JC )
00867   130          CONTINUE
00868   140       CONTINUE
00869 *
00870 *           Call CHPTRD and CUPGTR to compute S and U from AP
00871 *
00872             CALL CCOPY( NAP, AP, 1, VP, 1 )
00873 *
00874             NTEST = 7
00875             CALL CHPTRD( 'L', N, VP, SD, SE, TAU, IINFO )
00876 *
00877             IF( IINFO.NE.0 ) THEN
00878                WRITE( NOUNIT, FMT = 9999 )'CHPTRD(L)', IINFO, N, JTYPE,
00879      $            IOLDSD
00880                INFO = ABS( IINFO )
00881                IF( IINFO.LT.0 ) THEN
00882                   RETURN
00883                ELSE
00884                   RESULT( 7 ) = ULPINV
00885                   GO TO 280
00886                END IF
00887             END IF
00888 *
00889             NTEST = 8
00890             CALL CUPGTR( 'L', N, VP, TAU, U, LDU, WORK, IINFO )
00891             IF( IINFO.NE.0 ) THEN
00892                WRITE( NOUNIT, FMT = 9999 )'CUPGTR(L)', IINFO, N, JTYPE,
00893      $            IOLDSD
00894                INFO = ABS( IINFO )
00895                IF( IINFO.LT.0 ) THEN
00896                   RETURN
00897                ELSE
00898                   RESULT( 8 ) = ULPINV
00899                   GO TO 280
00900                END IF
00901             END IF
00902 *
00903             CALL CHPT21( 2, 'Lower', N, 1, AP, SD, SE, U, LDU, VP, TAU,
00904      $                   WORK, RWORK, RESULT( 7 ) )
00905             CALL CHPT21( 3, 'Lower', N, 1, AP, SD, SE, U, LDU, VP, TAU,
00906      $                   WORK, RWORK, RESULT( 8 ) )
00907 *
00908 *           Call CSTEQR to compute D1, D2, and Z, do tests.
00909 *
00910 *           Compute D1 and Z
00911 *
00912             CALL SCOPY( N, SD, 1, D1, 1 )
00913             IF( N.GT.0 )
00914      $         CALL SCOPY( N-1, SE, 1, RWORK, 1 )
00915             CALL CLASET( 'Full', N, N, CZERO, CONE, Z, LDU )
00916 *
00917             NTEST = 9
00918             CALL CSTEQR( 'V', N, D1, RWORK, Z, LDU, RWORK( N+1 ),
00919      $                   IINFO )
00920             IF( IINFO.NE.0 ) THEN
00921                WRITE( NOUNIT, FMT = 9999 )'CSTEQR(V)', IINFO, N, JTYPE,
00922      $            IOLDSD
00923                INFO = ABS( IINFO )
00924                IF( IINFO.LT.0 ) THEN
00925                   RETURN
00926                ELSE
00927                   RESULT( 9 ) = ULPINV
00928                   GO TO 280
00929                END IF
00930             END IF
00931 *
00932 *           Compute D2
00933 *
00934             CALL SCOPY( N, SD, 1, D2, 1 )
00935             IF( N.GT.0 )
00936      $         CALL SCOPY( N-1, SE, 1, RWORK, 1 )
00937 *
00938             NTEST = 11
00939             CALL CSTEQR( 'N', N, D2, RWORK, WORK, LDU, RWORK( N+1 ),
00940      $                   IINFO )
00941             IF( IINFO.NE.0 ) THEN
00942                WRITE( NOUNIT, FMT = 9999 )'CSTEQR(N)', IINFO, N, JTYPE,
00943      $            IOLDSD
00944                INFO = ABS( IINFO )
00945                IF( IINFO.LT.0 ) THEN
00946                   RETURN
00947                ELSE
00948                   RESULT( 11 ) = ULPINV
00949                   GO TO 280
00950                END IF
00951             END IF
00952 *
00953 *           Compute D3 (using PWK method)
00954 *
00955             CALL SCOPY( N, SD, 1, D3, 1 )
00956             IF( N.GT.0 )
00957      $         CALL SCOPY( N-1, SE, 1, RWORK, 1 )
00958 *
00959             NTEST = 12
00960             CALL SSTERF( N, D3, RWORK, IINFO )
00961             IF( IINFO.NE.0 ) THEN
00962                WRITE( NOUNIT, FMT = 9999 )'SSTERF', IINFO, N, JTYPE,
00963      $            IOLDSD
00964                INFO = ABS( IINFO )
00965                IF( IINFO.LT.0 ) THEN
00966                   RETURN
00967                ELSE
00968                   RESULT( 12 ) = ULPINV
00969                   GO TO 280
00970                END IF
00971             END IF
00972 *
00973 *           Do Tests 9 and 10
00974 *
00975             CALL CSTT21( N, 0, SD, SE, D1, DUMMA, Z, LDU, WORK, RWORK,
00976      $                   RESULT( 9 ) )
00977 *
00978 *           Do Tests 11 and 12
00979 *
00980             TEMP1 = ZERO
00981             TEMP2 = ZERO
00982             TEMP3 = ZERO
00983             TEMP4 = ZERO
00984 *
00985             DO 150 J = 1, N
00986                TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D2( J ) ) )
00987                TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
00988                TEMP3 = MAX( TEMP3, ABS( D1( J ) ), ABS( D3( J ) ) )
00989                TEMP4 = MAX( TEMP4, ABS( D1( J )-D3( J ) ) )
00990   150       CONTINUE
00991 *
00992             RESULT( 11 ) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
00993             RESULT( 12 ) = TEMP4 / MAX( UNFL, ULP*MAX( TEMP3, TEMP4 ) )
00994 *
00995 *           Do Test 13 -- Sturm Sequence Test of Eigenvalues
00996 *                         Go up by factors of two until it succeeds
00997 *
00998             NTEST = 13
00999             TEMP1 = THRESH*( HALF-ULP )
01000 *
01001             DO 160 J = 0, LOG2UI
01002                CALL SSTECH( N, SD, SE, D1, TEMP1, RWORK, IINFO )
01003                IF( IINFO.EQ.0 )
01004      $            GO TO 170
01005                TEMP1 = TEMP1*TWO
01006   160       CONTINUE
01007 *
01008   170       CONTINUE
01009             RESULT( 13 ) = TEMP1
01010 *
01011 *           For positive definite matrices ( JTYPE.GT.15 ) call CPTEQR
01012 *           and do tests 14, 15, and 16 .
01013 *
01014             IF( JTYPE.GT.15 ) THEN
01015 *
01016 *              Compute D4 and Z4
01017 *
01018                CALL SCOPY( N, SD, 1, D4, 1 )
01019                IF( N.GT.0 )
01020      $            CALL SCOPY( N-1, SE, 1, RWORK, 1 )
01021                CALL CLASET( 'Full', N, N, CZERO, CONE, Z, LDU )
01022 *
01023                NTEST = 14
01024                CALL CPTEQR( 'V', N, D4, RWORK, Z, LDU, RWORK( N+1 ),
01025      $                      IINFO )
01026                IF( IINFO.NE.0 ) THEN
01027                   WRITE( NOUNIT, FMT = 9999 )'CPTEQR(V)', IINFO, N,
01028      $               JTYPE, IOLDSD
01029                   INFO = ABS( IINFO )
01030                   IF( IINFO.LT.0 ) THEN
01031                      RETURN
01032                   ELSE
01033                      RESULT( 14 ) = ULPINV
01034                      GO TO 280
01035                   END IF
01036                END IF
01037 *
01038 *              Do Tests 14 and 15
01039 *
01040                CALL CSTT21( N, 0, SD, SE, D4, DUMMA, Z, LDU, WORK,
01041      $                      RWORK, RESULT( 14 ) )
01042 *
01043 *              Compute D5
01044 *
01045                CALL SCOPY( N, SD, 1, D5, 1 )
01046                IF( N.GT.0 )
01047      $            CALL SCOPY( N-1, SE, 1, RWORK, 1 )
01048 *
01049                NTEST = 16
01050                CALL CPTEQR( 'N', N, D5, RWORK, Z, LDU, RWORK( N+1 ),
01051      $                      IINFO )
01052                IF( IINFO.NE.0 ) THEN
01053                   WRITE( NOUNIT, FMT = 9999 )'CPTEQR(N)', IINFO, N,
01054      $               JTYPE, IOLDSD
01055                   INFO = ABS( IINFO )
01056                   IF( IINFO.LT.0 ) THEN
01057                      RETURN
01058                   ELSE
01059                      RESULT( 16 ) = ULPINV
01060                      GO TO 280
01061                   END IF
01062                END IF
01063 *
01064 *              Do Test 16
01065 *
01066                TEMP1 = ZERO
01067                TEMP2 = ZERO
01068                DO 180 J = 1, N
01069                   TEMP1 = MAX( TEMP1, ABS( D4( J ) ), ABS( D5( J ) ) )
01070                   TEMP2 = MAX( TEMP2, ABS( D4( J )-D5( J ) ) )
01071   180          CONTINUE
01072 *
01073                RESULT( 16 ) = TEMP2 / MAX( UNFL,
01074      $                        HUN*ULP*MAX( TEMP1, TEMP2 ) )
01075             ELSE
01076                RESULT( 14 ) = ZERO
01077                RESULT( 15 ) = ZERO
01078                RESULT( 16 ) = ZERO
01079             END IF
01080 *
01081 *           Call SSTEBZ with different options and do tests 17-18.
01082 *
01083 *              If S is positive definite and diagonally dominant,
01084 *              ask for all eigenvalues with high relative accuracy.
01085 *
01086             VL = ZERO
01087             VU = ZERO
01088             IL = 0
01089             IU = 0
01090             IF( JTYPE.EQ.21 ) THEN
01091                NTEST = 17
01092                ABSTOL = UNFL + UNFL
01093                CALL SSTEBZ( 'A', 'E', N, VL, VU, IL, IU, ABSTOL, SD, SE,
01094      $                      M, NSPLIT, WR, IWORK( 1 ), IWORK( N+1 ),
01095      $                      RWORK, IWORK( 2*N+1 ), IINFO )
01096                IF( IINFO.NE.0 ) THEN
01097                   WRITE( NOUNIT, FMT = 9999 )'SSTEBZ(A,rel)', IINFO, N,
01098      $               JTYPE, IOLDSD
01099                   INFO = ABS( IINFO )
01100                   IF( IINFO.LT.0 ) THEN
01101                      RETURN
01102                   ELSE
01103                      RESULT( 17 ) = ULPINV
01104                      GO TO 280
01105                   END IF
01106                END IF
01107 *
01108 *              Do test 17
01109 *
01110                TEMP2 = TWO*( TWO*N-ONE )*ULP*( ONE+EIGHT*HALF**2 ) /
01111      $                 ( ONE-HALF )**4
01112 *
01113                TEMP1 = ZERO
01114                DO 190 J = 1, N
01115                   TEMP1 = MAX( TEMP1, ABS( D4( J )-WR( N-J+1 ) ) /
01116      $                    ( ABSTOL+ABS( D4( J ) ) ) )
01117   190          CONTINUE
01118 *
01119                RESULT( 17 ) = TEMP1 / TEMP2
01120             ELSE
01121                RESULT( 17 ) = ZERO
01122             END IF
01123 *
01124 *           Now ask for all eigenvalues with high absolute accuracy.
01125 *
01126             NTEST = 18
01127             ABSTOL = UNFL + UNFL
01128             CALL SSTEBZ( 'A', 'E', N, VL, VU, IL, IU, ABSTOL, SD, SE, M,
01129      $                   NSPLIT, WA1, IWORK( 1 ), IWORK( N+1 ), RWORK,
01130      $                   IWORK( 2*N+1 ), IINFO )
01131             IF( IINFO.NE.0 ) THEN
01132                WRITE( NOUNIT, FMT = 9999 )'SSTEBZ(A)', IINFO, N, JTYPE,
01133      $            IOLDSD
01134                INFO = ABS( IINFO )
01135                IF( IINFO.LT.0 ) THEN
01136                   RETURN
01137                ELSE
01138                   RESULT( 18 ) = ULPINV
01139                   GO TO 280
01140                END IF
01141             END IF
01142 *
01143 *           Do test 18
01144 *
01145             TEMP1 = ZERO
01146             TEMP2 = ZERO
01147             DO 200 J = 1, N
01148                TEMP1 = MAX( TEMP1, ABS( D3( J ) ), ABS( WA1( J ) ) )
01149                TEMP2 = MAX( TEMP2, ABS( D3( J )-WA1( J ) ) )
01150   200       CONTINUE
01151 *
01152             RESULT( 18 ) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
01153 *
01154 *           Choose random values for IL and IU, and ask for the
01155 *           IL-th through IU-th eigenvalues.
01156 *
01157             NTEST = 19
01158             IF( N.LE.1 ) THEN
01159                IL = 1
01160                IU = N
01161             ELSE
01162                IL = 1 + ( N-1 )*INT( SLARND( 1, ISEED2 ) )
01163                IU = 1 + ( N-1 )*INT( SLARND( 1, ISEED2 ) )
01164                IF( IU.LT.IL ) THEN
01165                   ITEMP = IU
01166                   IU = IL
01167                   IL = ITEMP
01168                END IF
01169             END IF
01170 *
01171             CALL SSTEBZ( 'I', 'E', N, VL, VU, IL, IU, ABSTOL, SD, SE,
01172      $                   M2, NSPLIT, WA2, IWORK( 1 ), IWORK( N+1 ),
01173      $                   RWORK, IWORK( 2*N+1 ), IINFO )
01174             IF( IINFO.NE.0 ) THEN
01175                WRITE( NOUNIT, FMT = 9999 )'SSTEBZ(I)', IINFO, N, JTYPE,
01176      $            IOLDSD
01177                INFO = ABS( IINFO )
01178                IF( IINFO.LT.0 ) THEN
01179                   RETURN
01180                ELSE
01181                   RESULT( 19 ) = ULPINV
01182                   GO TO 280
01183                END IF
01184             END IF
01185 *
01186 *           Determine the values VL and VU of the IL-th and IU-th
01187 *           eigenvalues and ask for all eigenvalues in this range.
01188 *
01189             IF( N.GT.0 ) THEN
01190                IF( IL.NE.1 ) THEN
01191                   VL = WA1( IL ) - MAX( HALF*( WA1( IL )-WA1( IL-1 ) ),
01192      $                 ULP*ANORM, TWO*RTUNFL )
01193                ELSE
01194                   VL = WA1( 1 ) - MAX( HALF*( WA1( N )-WA1( 1 ) ),
01195      $                 ULP*ANORM, TWO*RTUNFL )
01196                END IF
01197                IF( IU.NE.N ) THEN
01198                   VU = WA1( IU ) + MAX( HALF*( WA1( IU+1 )-WA1( IU ) ),
01199      $                 ULP*ANORM, TWO*RTUNFL )
01200                ELSE
01201                   VU = WA1( N ) + MAX( HALF*( WA1( N )-WA1( 1 ) ),
01202      $                 ULP*ANORM, TWO*RTUNFL )
01203                END IF
01204             ELSE
01205                VL = ZERO
01206                VU = ONE
01207             END IF
01208 *
01209             CALL SSTEBZ( 'V', 'E', N, VL, VU, IL, IU, ABSTOL, SD, SE,
01210      $                   M3, NSPLIT, WA3, IWORK( 1 ), IWORK( N+1 ),
01211      $                   RWORK, IWORK( 2*N+1 ), IINFO )
01212             IF( IINFO.NE.0 ) THEN
01213                WRITE( NOUNIT, FMT = 9999 )'SSTEBZ(V)', IINFO, N, JTYPE,
01214      $            IOLDSD
01215                INFO = ABS( IINFO )
01216                IF( IINFO.LT.0 ) THEN
01217                   RETURN
01218                ELSE
01219                   RESULT( 19 ) = ULPINV
01220                   GO TO 280
01221                END IF
01222             END IF
01223 *
01224             IF( M3.EQ.0 .AND. N.NE.0 ) THEN
01225                RESULT( 19 ) = ULPINV
01226                GO TO 280
01227             END IF
01228 *
01229 *           Do test 19
01230 *
01231             TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
01232             TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
01233             IF( N.GT.0 ) THEN
01234                TEMP3 = MAX( ABS( WA1( N ) ), ABS( WA1( 1 ) ) )
01235             ELSE
01236                TEMP3 = ZERO
01237             END IF
01238 *
01239             RESULT( 19 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, TEMP3*ULP )
01240 *
01241 *           Call CSTEIN to compute eigenvectors corresponding to
01242 *           eigenvalues in WA1.  (First call SSTEBZ again, to make sure
01243 *           it returns these eigenvalues in the correct order.)
01244 *
01245             NTEST = 21
01246             CALL SSTEBZ( 'A', 'B', N, VL, VU, IL, IU, ABSTOL, SD, SE, M,
01247      $                   NSPLIT, WA1, IWORK( 1 ), IWORK( N+1 ), RWORK,
01248      $                   IWORK( 2*N+1 ), IINFO )
01249             IF( IINFO.NE.0 ) THEN
01250                WRITE( NOUNIT, FMT = 9999 )'SSTEBZ(A,B)', IINFO, N,
01251      $            JTYPE, IOLDSD
01252                INFO = ABS( IINFO )
01253                IF( IINFO.LT.0 ) THEN
01254                   RETURN
01255                ELSE
01256                   RESULT( 20 ) = ULPINV
01257                   RESULT( 21 ) = ULPINV
01258                   GO TO 280
01259                END IF
01260             END IF
01261 *
01262             CALL CSTEIN( N, SD, SE, M, WA1, IWORK( 1 ), IWORK( N+1 ), Z,
01263      $                   LDU, RWORK, IWORK( 2*N+1 ), IWORK( 3*N+1 ),
01264      $                   IINFO )
01265             IF( IINFO.NE.0 ) THEN
01266                WRITE( NOUNIT, FMT = 9999 )'CSTEIN', IINFO, N, JTYPE,
01267      $            IOLDSD
01268                INFO = ABS( IINFO )
01269                IF( IINFO.LT.0 ) THEN
01270                   RETURN
01271                ELSE
01272                   RESULT( 20 ) = ULPINV
01273                   RESULT( 21 ) = ULPINV
01274                   GO TO 280
01275                END IF
01276             END IF
01277 *
01278 *           Do tests 20 and 21
01279 *
01280             CALL CSTT21( N, 0, SD, SE, WA1, DUMMA, Z, LDU, WORK, RWORK,
01281      $                   RESULT( 20 ) )
01282 *
01283 *           Call CSTEDC(I) to compute D1 and Z, do tests.
01284 *
01285 *           Compute D1 and Z
01286 *
01287             INDE = 1
01288             INDRWK = INDE + N
01289             CALL SCOPY( N, SD, 1, D1, 1 )
01290             IF( N.GT.0 )
01291      $         CALL SCOPY( N-1, SE, 1, RWORK( INDE ), 1 )
01292             CALL CLASET( 'Full', N, N, CZERO, CONE, Z, LDU )
01293 *
01294             NTEST = 22
01295             CALL CSTEDC( 'I', N, D1, RWORK( INDE ), Z, LDU, WORK, LWEDC,
01296      $                   RWORK( INDRWK ), LRWEDC, IWORK, LIWEDC, IINFO )
01297             IF( IINFO.NE.0 ) THEN
01298                WRITE( NOUNIT, FMT = 9999 )'CSTEDC(I)', IINFO, N, JTYPE,
01299      $            IOLDSD
01300                INFO = ABS( IINFO )
01301                IF( IINFO.LT.0 ) THEN
01302                   RETURN
01303                ELSE
01304                   RESULT( 22 ) = ULPINV
01305                   GO TO 280
01306                END IF
01307             END IF
01308 *
01309 *           Do Tests 22 and 23
01310 *
01311             CALL CSTT21( N, 0, SD, SE, D1, DUMMA, Z, LDU, WORK, RWORK,
01312      $                   RESULT( 22 ) )
01313 *
01314 *           Call CSTEDC(V) to compute D1 and Z, do tests.
01315 *
01316 *           Compute D1 and Z
01317 *
01318             CALL SCOPY( N, SD, 1, D1, 1 )
01319             IF( N.GT.0 )
01320      $         CALL SCOPY( N-1, SE, 1, RWORK( INDE ), 1 )
01321             CALL CLASET( 'Full', N, N, CZERO, CONE, Z, LDU )
01322 *
01323             NTEST = 24
01324             CALL CSTEDC( 'V', N, D1, RWORK( INDE ), Z, LDU, WORK, LWEDC,
01325      $                   RWORK( INDRWK ), LRWEDC, IWORK, LIWEDC, IINFO )
01326             IF( IINFO.NE.0 ) THEN
01327                WRITE( NOUNIT, FMT = 9999 )'CSTEDC(V)', IINFO, N, JTYPE,
01328      $            IOLDSD
01329                INFO = ABS( IINFO )
01330                IF( IINFO.LT.0 ) THEN
01331                   RETURN
01332                ELSE
01333                   RESULT( 24 ) = ULPINV
01334                   GO TO 280
01335                END IF
01336             END IF
01337 *
01338 *           Do Tests 24 and 25
01339 *
01340             CALL CSTT21( N, 0, SD, SE, D1, DUMMA, Z, LDU, WORK, RWORK,
01341      $                   RESULT( 24 ) )
01342 *
01343 *           Call CSTEDC(N) to compute D2, do tests.
01344 *
01345 *           Compute D2
01346 *
01347             CALL SCOPY( N, SD, 1, D2, 1 )
01348             IF( N.GT.0 )
01349      $         CALL SCOPY( N-1, SE, 1, RWORK( INDE ), 1 )
01350             CALL CLASET( 'Full', N, N, CZERO, CONE, Z, LDU )
01351 *
01352             NTEST = 26
01353             CALL CSTEDC( 'N', N, D2, RWORK( INDE ), Z, LDU, WORK, LWEDC,
01354      $                   RWORK( INDRWK ), LRWEDC, IWORK, LIWEDC, IINFO )
01355             IF( IINFO.NE.0 ) THEN
01356                WRITE( NOUNIT, FMT = 9999 )'CSTEDC(N)', IINFO, N, JTYPE,
01357      $            IOLDSD
01358                INFO = ABS( IINFO )
01359                IF( IINFO.LT.0 ) THEN
01360                   RETURN
01361                ELSE
01362                   RESULT( 26 ) = ULPINV
01363                   GO TO 280
01364                END IF
01365             END IF
01366 *
01367 *           Do Test 26
01368 *
01369             TEMP1 = ZERO
01370             TEMP2 = ZERO
01371 *
01372             DO 210 J = 1, N
01373                TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D2( J ) ) )
01374                TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
01375   210       CONTINUE
01376 *
01377             RESULT( 26 ) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
01378 *
01379 *           Only test CSTEMR if IEEE compliant
01380 *
01381             IF( ILAENV( 10, 'CSTEMR', 'VA', 1, 0, 0, 0 ).EQ.1 .AND.
01382      $          ILAENV( 11, 'CSTEMR', 'VA', 1, 0, 0, 0 ).EQ.1 ) THEN
01383 *
01384 *           Call CSTEMR, do test 27 (relative eigenvalue accuracy)
01385 *
01386 *              If S is positive definite and diagonally dominant,
01387 *              ask for all eigenvalues with high relative accuracy.
01388 *
01389                VL = ZERO
01390                VU = ZERO
01391                IL = 0
01392                IU = 0
01393                IF( JTYPE.EQ.21 .AND. CREL ) THEN
01394                   NTEST = 27
01395                   ABSTOL = UNFL + UNFL
01396                   CALL CSTEMR( 'V', 'A', N, SD, SE, VL, VU, IL, IU,
01397      $                         M, WR, Z, LDU, N, IWORK( 1 ), TRYRAC,
01398      $                         RWORK, LRWORK, IWORK( 2*N+1 ), LWORK-2*N,
01399      $                         IINFO )
01400                   IF( IINFO.NE.0 ) THEN
01401                      WRITE( NOUNIT, FMT = 9999 )'CSTEMR(V,A,rel)',
01402      $                  IINFO, N, JTYPE, IOLDSD
01403                      INFO = ABS( IINFO )
01404                      IF( IINFO.LT.0 ) THEN
01405                         RETURN
01406                      ELSE
01407                         RESULT( 27 ) = ULPINV
01408                         GO TO 270
01409                      END IF
01410                   END IF
01411 *
01412 *              Do test 27
01413 *
01414                   TEMP2 = TWO*( TWO*N-ONE )*ULP*( ONE+EIGHT*HALF**2 ) /
01415      $                    ( ONE-HALF )**4
01416 *
01417                   TEMP1 = ZERO
01418                   DO 220 J = 1, N
01419                      TEMP1 = MAX( TEMP1, ABS( D4( J )-WR( N-J+1 ) ) /
01420      $                       ( ABSTOL+ABS( D4( J ) ) ) )
01421   220             CONTINUE
01422 *
01423                   RESULT( 27 ) = TEMP1 / TEMP2
01424 *
01425                   IL = 1 + ( N-1 )*INT( SLARND( 1, ISEED2 ) )
01426                   IU = 1 + ( N-1 )*INT( SLARND( 1, ISEED2 ) )
01427                   IF( IU.LT.IL ) THEN
01428                      ITEMP = IU
01429                      IU = IL
01430                      IL = ITEMP
01431                   END IF
01432 *
01433                   IF( CRANGE ) THEN
01434                      NTEST = 28
01435                      ABSTOL = UNFL + UNFL
01436                      CALL CSTEMR( 'V', 'I', N, SD, SE, VL, VU, IL, IU,
01437      $                            M, WR, Z, LDU, N, IWORK( 1 ), TRYRAC,
01438      $                            RWORK, LRWORK, IWORK( 2*N+1 ),
01439      $                            LWORK-2*N, IINFO )
01440 *
01441                      IF( IINFO.NE.0 ) THEN
01442                         WRITE( NOUNIT, FMT = 9999 )'CSTEMR(V,I,rel)',
01443      $                     IINFO, N, JTYPE, IOLDSD
01444                         INFO = ABS( IINFO )
01445                         IF( IINFO.LT.0 ) THEN
01446                            RETURN
01447                         ELSE
01448                            RESULT( 28 ) = ULPINV
01449                            GO TO 270
01450                         END IF
01451                      END IF
01452 *
01453 *
01454 *                 Do test 28
01455 *
01456                      TEMP2 = TWO*( TWO*N-ONE )*ULP*
01457      $                       ( ONE+EIGHT*HALF**2 ) / ( ONE-HALF )**4
01458 *
01459                      TEMP1 = ZERO
01460                      DO 230 J = IL, IU
01461                         TEMP1 = MAX( TEMP1, ABS( WR( J-IL+1 )-D4( N-J+
01462      $                          1 ) ) / ( ABSTOL+ABS( WR( J-IL+1 ) ) ) )
01463   230                CONTINUE
01464 *
01465                      RESULT( 28 ) = TEMP1 / TEMP2
01466                   ELSE
01467                      RESULT( 28 ) = ZERO
01468                   END IF
01469                ELSE
01470                   RESULT( 27 ) = ZERO
01471                   RESULT( 28 ) = ZERO
01472                END IF
01473 *
01474 *           Call CSTEMR(V,I) to compute D1 and Z, do tests.
01475 *
01476 *           Compute D1 and Z
01477 *
01478                CALL SCOPY( N, SD, 1, D5, 1 )
01479                IF( N.GT.0 )
01480      $            CALL SCOPY( N-1, SE, 1, RWORK, 1 )
01481                CALL CLASET( 'Full', N, N, CZERO, CONE, Z, LDU )
01482 *
01483                IF( CRANGE ) THEN
01484                   NTEST = 29
01485                   IL = 1 + ( N-1 )*INT( SLARND( 1, ISEED2 ) )
01486                   IU = 1 + ( N-1 )*INT( SLARND( 1, ISEED2 ) )
01487                   IF( IU.LT.IL ) THEN
01488                      ITEMP = IU
01489                      IU = IL
01490                      IL = ITEMP
01491                   END IF
01492                   CALL CSTEMR( 'V', 'I', N, D5, RWORK, VL, VU, IL, IU,
01493      $                         M, D1, Z, LDU, N, IWORK( 1 ), TRYRAC,
01494      $                         RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ),
01495      $                         LIWORK-2*N, IINFO )
01496                   IF( IINFO.NE.0 ) THEN
01497                      WRITE( NOUNIT, FMT = 9999 )'CSTEMR(V,I)', IINFO,
01498      $                  N, JTYPE, IOLDSD
01499                      INFO = ABS( IINFO )
01500                      IF( IINFO.LT.0 ) THEN
01501                         RETURN
01502                      ELSE
01503                         RESULT( 29 ) = ULPINV
01504                         GO TO 280
01505                      END IF
01506                   END IF
01507 *
01508 *           Do Tests 29 and 30
01509 *
01510 *
01511 *           Call CSTEMR to compute D2, do tests.
01512 *
01513 *           Compute D2
01514 *
01515                   CALL SCOPY( N, SD, 1, D5, 1 )
01516                   IF( N.GT.0 )
01517      $               CALL SCOPY( N-1, SE, 1, RWORK, 1 )
01518 *
01519                   NTEST = 31
01520                   CALL CSTEMR( 'N', 'I', N, D5, RWORK, VL, VU, IL, IU,
01521      $                         M, D2, Z, LDU, N, IWORK( 1 ), TRYRAC,
01522      $                         RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ),
01523      $                         LIWORK-2*N, IINFO )
01524                   IF( IINFO.NE.0 ) THEN
01525                      WRITE( NOUNIT, FMT = 9999 )'CSTEMR(N,I)', IINFO,
01526      $                  N, JTYPE, IOLDSD
01527                      INFO = ABS( IINFO )
01528                      IF( IINFO.LT.0 ) THEN
01529                         RETURN
01530                      ELSE
01531                         RESULT( 31 ) = ULPINV
01532                         GO TO 280
01533                      END IF
01534                   END IF
01535 *
01536 *           Do Test 31
01537 *
01538                   TEMP1 = ZERO
01539                   TEMP2 = ZERO
01540 *
01541                   DO 240 J = 1, IU - IL + 1
01542                      TEMP1 = MAX( TEMP1, ABS( D1( J ) ),
01543      $                       ABS( D2( J ) ) )
01544                      TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
01545   240             CONTINUE
01546 *
01547                   RESULT( 31 ) = TEMP2 / MAX( UNFL,
01548      $                           ULP*MAX( TEMP1, TEMP2 ) )
01549 *
01550 *
01551 *           Call CSTEMR(V,V) to compute D1 and Z, do tests.
01552 *
01553 *           Compute D1 and Z
01554 *
01555                   CALL SCOPY( N, SD, 1, D5, 1 )
01556                   IF( N.GT.0 )
01557      $               CALL SCOPY( N-1, SE, 1, RWORK, 1 )
01558                   CALL CLASET( 'Full', N, N, CZERO, CONE, Z, LDU )
01559 *
01560                   NTEST = 32
01561 *
01562                   IF( N.GT.0 ) THEN
01563                      IF( IL.NE.1 ) THEN
01564                         VL = D2( IL ) - MAX( HALF*
01565      $                       ( D2( IL )-D2( IL-1 ) ), ULP*ANORM,
01566      $                       TWO*RTUNFL )
01567                      ELSE
01568                         VL = D2( 1 ) - MAX( HALF*( D2( N )-D2( 1 ) ),
01569      $                       ULP*ANORM, TWO*RTUNFL )
01570                      END IF
01571                      IF( IU.NE.N ) THEN
01572                         VU = D2( IU ) + MAX( HALF*
01573      $                       ( D2( IU+1 )-D2( IU ) ), ULP*ANORM,
01574      $                       TWO*RTUNFL )
01575                      ELSE
01576                         VU = D2( N ) + MAX( HALF*( D2( N )-D2( 1 ) ),
01577      $                       ULP*ANORM, TWO*RTUNFL )
01578                      END IF
01579                   ELSE
01580                      VL = ZERO
01581                      VU = ONE
01582                   END IF
01583 *
01584                   CALL CSTEMR( 'V', 'V', N, D5, RWORK, VL, VU, IL, IU,
01585      $                         M, D1, Z, LDU, N, IWORK( 1 ), TRYRAC,
01586      $                         RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ),
01587      $                         LIWORK-2*N, IINFO )
01588                   IF( IINFO.NE.0 ) THEN
01589                      WRITE( NOUNIT, FMT = 9999 )'CSTEMR(V,V)', IINFO,
01590      $                  N, JTYPE, IOLDSD
01591                      INFO = ABS( IINFO )
01592                      IF( IINFO.LT.0 ) THEN
01593                         RETURN
01594                      ELSE
01595                         RESULT( 32 ) = ULPINV
01596                         GO TO 280
01597                      END IF
01598                   END IF
01599 *
01600 *           Do Tests 32 and 33
01601 *
01602                   CALL CSTT22( N, M, 0, SD, SE, D1, DUMMA, Z, LDU, WORK,
01603      $                         M, RWORK, RESULT( 32 ) )
01604 *
01605 *           Call CSTEMR to compute D2, do tests.
01606 *
01607 *           Compute D2
01608 *
01609                   CALL SCOPY( N, SD, 1, D5, 1 )
01610                   IF( N.GT.0 )
01611      $               CALL SCOPY( N-1, SE, 1, RWORK, 1 )
01612 *
01613                   NTEST = 34
01614                   CALL CSTEMR( 'N', 'V', N, D5, RWORK, VL, VU, IL, IU,
01615      $                         M, D2, Z, LDU, N, IWORK( 1 ), TRYRAC,
01616      $                         RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ),
01617      $                         LIWORK-2*N, IINFO )
01618                   IF( IINFO.NE.0 ) THEN
01619                      WRITE( NOUNIT, FMT = 9999 )'CSTEMR(N,V)', IINFO,
01620      $                  N, JTYPE, IOLDSD
01621                      INFO = ABS( IINFO )
01622                      IF( IINFO.LT.0 ) THEN
01623                         RETURN
01624                      ELSE
01625                         RESULT( 34 ) = ULPINV
01626                         GO TO 280
01627                      END IF
01628                   END IF
01629 *
01630 *           Do Test 34
01631 *
01632                   TEMP1 = ZERO
01633                   TEMP2 = ZERO
01634 *
01635                   DO 250 J = 1, IU - IL + 1
01636                      TEMP1 = MAX( TEMP1, ABS( D1( J ) ),
01637      $                       ABS( D2( J ) ) )
01638                      TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
01639   250             CONTINUE
01640 *
01641                   RESULT( 34 ) = TEMP2 / MAX( UNFL,
01642      $                           ULP*MAX( TEMP1, TEMP2 ) )
01643                ELSE
01644                   RESULT( 29 ) = ZERO
01645                   RESULT( 30 ) = ZERO
01646                   RESULT( 31 ) = ZERO
01647                   RESULT( 32 ) = ZERO
01648                   RESULT( 33 ) = ZERO
01649                   RESULT( 34 ) = ZERO
01650                END IF
01651 *
01652 *
01653 *           Call CSTEMR(V,A) to compute D1 and Z, do tests.
01654 *
01655 *           Compute D1 and Z
01656 *
01657                CALL SCOPY( N, SD, 1, D5, 1 )
01658                IF( N.GT.0 )
01659      $            CALL SCOPY( N-1, SE, 1, RWORK, 1 )
01660 *
01661                NTEST = 35
01662 *
01663                CALL CSTEMR( 'V', 'A', N, D5, RWORK, VL, VU, IL, IU,
01664      $                      M, D1, Z, LDU, N, IWORK( 1 ), TRYRAC,
01665      $                      RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ),
01666      $                      LIWORK-2*N, IINFO )
01667                IF( IINFO.NE.0 ) THEN
01668                   WRITE( NOUNIT, FMT = 9999 )'CSTEMR(V,A)', IINFO, N,
01669      $               JTYPE, IOLDSD
01670                   INFO = ABS( IINFO )
01671                   IF( IINFO.LT.0 ) THEN
01672                      RETURN
01673                   ELSE
01674                      RESULT( 35 ) = ULPINV
01675                      GO TO 280
01676                   END IF
01677                END IF
01678 *
01679 *           Do Tests 35 and 36
01680 *
01681                CALL CSTT22( N, M, 0, SD, SE, D1, DUMMA, Z, LDU, WORK, M,
01682      $                      RWORK, RESULT( 35 ) )
01683 *
01684 *           Call CSTEMR to compute D2, do tests.
01685 *
01686 *           Compute D2
01687 *
01688                CALL SCOPY( N, SD, 1, D5, 1 )
01689                IF( N.GT.0 )
01690      $            CALL SCOPY( N-1, SE, 1, RWORK, 1 )
01691 *
01692                NTEST = 37
01693                CALL CSTEMR( 'N', 'A', N, D5, RWORK, VL, VU, IL, IU,
01694      $                      M, D2, Z, LDU, N, IWORK( 1 ), TRYRAC,
01695      $                      RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ),
01696      $                      LIWORK-2*N, IINFO )
01697                IF( IINFO.NE.0 ) THEN
01698                   WRITE( NOUNIT, FMT = 9999 )'CSTEMR(N,A)', IINFO, N,
01699      $               JTYPE, IOLDSD
01700                   INFO = ABS( IINFO )
01701                   IF( IINFO.LT.0 ) THEN
01702                      RETURN
01703                   ELSE
01704                      RESULT( 37 ) = ULPINV
01705                      GO TO 280
01706                   END IF
01707                END IF
01708 *
01709 *           Do Test 34
01710 *
01711                TEMP1 = ZERO
01712                TEMP2 = ZERO
01713 *
01714                DO 260 J = 1, N
01715                   TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D2( J ) ) )
01716                   TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
01717   260          CONTINUE
01718 *
01719                RESULT( 37 ) = TEMP2 / MAX( UNFL,
01720      $                        ULP*MAX( TEMP1, TEMP2 ) )
01721             END IF
01722   270       CONTINUE
01723   280       CONTINUE
01724             NTESTT = NTESTT + NTEST
01725 *
01726 *           End of Loop -- Check for RESULT(j) > THRESH
01727 *
01728 *
01729 *           Print out tests which fail.
01730 *
01731             DO 290 JR = 1, NTEST
01732                IF( RESULT( JR ).GE.THRESH ) THEN
01733 *
01734 *                 If this is the first test to fail,
01735 *                 print a header to the data file.
01736 *
01737                   IF( NERRS.EQ.0 ) THEN
01738                      WRITE( NOUNIT, FMT = 9998 )'CST'
01739                      WRITE( NOUNIT, FMT = 9997 )
01740                      WRITE( NOUNIT, FMT = 9996 )
01741                      WRITE( NOUNIT, FMT = 9995 )'Hermitian'
01742                      WRITE( NOUNIT, FMT = 9994 )
01743 *
01744 *                    Tests performed
01745 *
01746                      WRITE( NOUNIT, FMT = 9987 )
01747                   END IF
01748                   NERRS = NERRS + 1
01749                   IF( RESULT( JR ).LT.10000.0E0 ) THEN
01750                      WRITE( NOUNIT, FMT = 9989 )N, JTYPE, IOLDSD, JR,
01751      $                  RESULT( JR )
01752                   ELSE
01753                      WRITE( NOUNIT, FMT = 9988 )N, JTYPE, IOLDSD, JR,
01754      $                  RESULT( JR )
01755                   END IF
01756                END IF
01757   290       CONTINUE
01758   300    CONTINUE
01759   310 CONTINUE
01760 *
01761 *     Summary
01762 *
01763       CALL SLASUM( 'CST', NOUNIT, NERRS, NTESTT )
01764       RETURN
01765 *
01766  9999 FORMAT( ' CCHKST: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
01767      $      I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
01768 *
01769  9998 FORMAT( / 1X, A3, ' -- Complex Hermitian eigenvalue problem' )
01770  9997 FORMAT( ' Matrix types (see CCHKST for details): ' )
01771 *
01772  9996 FORMAT( / ' Special Matrices:',
01773      $      / '  1=Zero matrix.                        ',
01774      $      '  5=Diagonal: clustered entries.',
01775      $      / '  2=Identity matrix.                    ',
01776      $      '  6=Diagonal: large, evenly spaced.',
01777      $      / '  3=Diagonal: evenly spaced entries.    ',
01778      $      '  7=Diagonal: small, evenly spaced.',
01779      $      / '  4=Diagonal: geometr. spaced entries.' )
01780  9995 FORMAT( ' Dense ', A, ' Matrices:',
01781      $      / '  8=Evenly spaced eigenvals.            ',
01782      $      ' 12=Small, evenly spaced eigenvals.',
01783      $      / '  9=Geometrically spaced eigenvals.     ',
01784      $      ' 13=Matrix with random O(1) entries.',
01785      $      / ' 10=Clustered eigenvalues.              ',
01786      $      ' 14=Matrix with large random entries.',
01787      $      / ' 11=Large, evenly spaced eigenvals.     ',
01788      $      ' 15=Matrix with small random entries.' )
01789  9994 FORMAT( ' 16=Positive definite, evenly spaced eigenvalues',
01790      $      / ' 17=Positive definite, geometrically spaced eigenvlaues',
01791      $      / ' 18=Positive definite, clustered eigenvalues',
01792      $      / ' 19=Positive definite, small evenly spaced eigenvalues',
01793      $      / ' 20=Positive definite, large evenly spaced eigenvalues',
01794      $      / ' 21=Diagonally dominant tridiagonal, geometrically',
01795      $      ' spaced eigenvalues' )
01796 *
01797  9993 FORMAT( / ' Tests performed:   ',
01798      $      '(S is Tridiag, D is diagonal, U and Z are ', A, ',', / 20X,
01799      $      A, ', W is a diagonal matrix of eigenvalues,', / 20X,
01800      $      ' V is U represented by Householder vectors, and', / 20X,
01801      $      ' Y is a matrix of eigenvectors of S.)',
01802      $      / ' CHETRD, UPLO=''U'':', / '  1= | A - V S V', A1,
01803      $      ' | / ( |A| n ulp )     ', '  2= | I - U V', A1,
01804      $      ' | / ( n ulp )', / ' CHETRD, UPLO=''L'':',
01805      $      / '  3= | A - V S V', A1, ' | / ( |A| n ulp )     ',
01806      $      '  4= | I - U V', A1, ' | / ( n ulp )' )
01807  9992 FORMAT( ' CHPTRD, UPLO=''U'':', / '  5= | A - V S V', A1,
01808      $      ' | / ( |A| n ulp )     ', '  6= | I - U V', A1,
01809      $      ' | / ( n ulp )', / ' CHPTRD, UPLO=''L'':',
01810      $      / '  7= | A - V S V', A1, ' | / ( |A| n ulp )     ',
01811      $      '  8= | I - U V', A1, ' | / ( n ulp )',
01812      $      / '  9= | S - Z D Z', A1, ' | / ( |S| n ulp )     ',
01813      $      ' 10= | I - Z Z', A1, ' | / ( n ulp )',
01814      $      / ' 11= |D(with Z) - D(w/o Z)| / (|D| ulp) ',
01815      $      ' 12= | D(PWK) - D(QR) | / (|D| ulp)',
01816      $      / ' 13=   Sturm sequence test on W         ' )
01817  9991 FORMAT( ' 14= | S - Z4 D4 Z4', A1, ' | / (|S| n ulp)',
01818      $      / ' 15= | I - Z4 Z4', A1, ' | / (n ulp ) ',
01819      $      ' 16= | D4 - D5 | / ( 100 |D4| ulp ) ',
01820      $      / ' 17= max | D4(i) - WR(i) | / ( |D4(i)| (2n-1) ulp )',
01821      $      / ' 18= | WA1 - D3 | / ( |D3| ulp )',
01822      $      / ' 19= max | WA2(i) - WA3(ii) | / ( |D3| ulp )',
01823      $      / ' 20= | S - Y WA1 Y', A1, ' | / ( |S| n ulp )',
01824      $      / ' 21= | I - Y Y', A1, ' | / ( n ulp )' )
01825  9990 FORMAT( ' 22= | S - Z D Z', A1,
01826      $      ' | / ( |S| n ulp ) for CSTEDC(I)', / ' 23= | I - Z Z', A1,
01827      $      ' | / ( n ulp )       for CSTEDC(I)', / ' 24= | S - Z D Z',
01828      $      A1, ' | / ( |S| n ulp ) for CSTEDC(V)', / ' 25= | I - Z Z',
01829      $      A1, ' | / ( n ulp )       for CSTEDC(V)',
01830      $      / ' 26= | D1(CSTEDC(V)) - D2(CSTEDC(N)) | / ( |D1| ulp )' )
01831  9989 FORMAT( ' Matrix order=', I5, ', type=', I2, ', seed=',
01832      $      4( I4, ',' ), ' result ', I3, ' is', 0P, F8.2 )
01833  9988 FORMAT( ' Matrix order=', I5, ', type=', I2, ', seed=',
01834      $      4( I4, ',' ), ' result ', I3, ' is', 1P, E10.3 )
01835 *
01836  9987 FORMAT( / 'Test performed:  see CCHKST for details.', / )
01837 *     End of CCHKST
01838 *
01839       END