Home
Browse Files
   1       SUBROUTINE CCHKST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
   2      $                   NOUNIT, A, LDA, AP, SD, SE, D1, D2, D3, D4, D5,
   3      $                   WA1, WA2, WA3, WR, U, LDU, V, VP, TAU, Z, WORK,
   4      $                   LWORK, RWORK, LRWORK, IWORK, LIWORK, RESULT,
   5      $                   INFO )
   6       IMPLICIT NONE
   7 *
   8 *  -- LAPACK test routine (version 3.1) --
   9 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
  10 *     November 2006
  11 *
  12 *     .. Scalar Arguments ..
  13       INTEGER            INFO, LDA, LDU, LIWORK, LRWORK, LWORK, NOUNIT,
  14      $                   NSIZES, NTYPES
  15       REAL               THRESH
  16 *     ..
  17 *     .. Array Arguments ..
  18       LOGICAL            DOTYPE( * )
  19       INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
  20       REAL               D1( * ), D2( * ), D3( * ), D4( * ), D5( * ),
  21      $                   RESULT( * ), RWORK( * ), SD( * ), SE( * ),
  22      $                   WA1( * ), WA2( * ), WA3( * ), WR( * )
  23       COMPLEX            A( LDA, * ), AP( * ), TAU( * ), U( LDU, * ),
  24      $                   V( LDU, * ), VP( * ), WORK( * ), Z( LDU, * )
  25 *     ..
  26 *
  27 *  Purpose
  28 *  =======
  29 *
  30 *  CCHKST  checks the Hermitian eigenvalue problem routines.
  31 *
  32 *     CHETRD factors A as  U S U* , where * means conjugate transpose,
  33 *     S is real symmetric tridiagonal, and U is unitary.
  34 *     CHETRD can use either just the lower or just the upper triangle
  35 *     of A; CCHKST checks both cases.
  36 *     U is represented as a product of Householder
  37 *     transformations, whose vectors are stored in the first
  38 *     n-1 columns of V, and whose scale factors are in TAU.
  39 *
  40 *     CHPTRD does the same as CHETRD, except that A and V are stored
  41 *     in "packed" format.
  42 *
  43 *     CUNGTR constructs the matrix U from the contents of V and TAU.
  44 *
  45 *     CUPGTR constructs the matrix U from the contents of VP and TAU.
  46 *
  47 *     CSTEQR factors S as  Z D1 Z* , where Z is the unitary
  48 *     matrix of eigenvectors and D1 is a diagonal matrix with
  49 *     the eigenvalues on the diagonal.  D2 is the matrix of
  50 *     eigenvalues computed when Z is not computed.
  51 *
  52 *     SSTERF computes D3, the matrix of eigenvalues, by the
  53 *     PWK method, which does not yield eigenvectors.
  54 *
  55 *     CPTEQR factors S as  Z4 D4 Z4* , for a
  56 *     Hermitian positive definite tridiagonal matrix.
  57 *     D5 is the matrix of eigenvalues computed when Z is not
  58 *     computed.
  59 *
  60 *     SSTEBZ computes selected eigenvalues.  WA1, WA2, and
  61 *     WA3 will denote eigenvalues computed to high
  62 *     absolute accuracy, with different range options.
  63 *     WR will denote eigenvalues computed to high relative
  64 *     accuracy.
  65 *
  66 *     CSTEIN computes Y, the eigenvectors of S, given the
  67 *     eigenvalues.
  68 *
  69 *     CSTEDC factors S as Z D1 Z* , where Z is the unitary
  70 *     matrix of eigenvectors and D1 is a diagonal matrix with
  71 *     the eigenvalues on the diagonal ('I' option). It may also
  72 *     update an input unitary matrix, usually the output
  73 *     from CHETRD/CUNGTR or CHPTRD/CUPGTR ('V' option). It may
  74 *     also just compute eigenvalues ('N' option).
  75 *
  76 *     CSTEMR factors S as Z D1 Z* , where Z is the unitary
  77 *     matrix of eigenvectors and D1 is a diagonal matrix with
  78 *     the eigenvalues on the diagonal ('I' option).  CSTEMR
  79 *     uses the Relatively Robust Representation whenever possible.
  80 *
  81 *  When CCHKST is called, a number of matrix "sizes" ("n's") and a
  82 *  number of matrix "types" are specified.  For each size ("n")
  83 *  and each type of matrix, one matrix will be generated and used
  84 *  to test the Hermitian eigenroutines.  For each matrix, a number
  85 *  of tests will be performed:
  86 *
  87 *  (1)     | A - V S V* | / ( |A| n ulp ) CHETRD( UPLO='U', ... )
  88 *
  89 *  (2)     | I - UV* | / ( n ulp )        CUNGTR( UPLO='U', ... )
  90 *
  91 *  (3)     | A - V S V* | / ( |A| n ulp ) CHETRD( UPLO='L', ... )
  92 *
  93 *  (4)     | I - UV* | / ( n ulp )        CUNGTR( UPLO='L', ... )
  94 *
  95 *  (5-8)   Same as 1-4, but for CHPTRD and CUPGTR.
  96 *
  97 *  (9)     | S - Z D Z* | / ( |S| n ulp ) CSTEQR('V',...)
  98 *
  99 *  (10)    | I - ZZ* | / ( n ulp )        CSTEQR('V',...)
 100 *
 101 *  (11)    | D1 - D2 | / ( |D1| ulp )        CSTEQR('N',...)
 102 *
 103 *  (12)    | D1 - D3 | / ( |D1| ulp )        SSTERF
 104 *
 105 *  (13)    0 if the true eigenvalues (computed by sturm count)
 106 *          of S are within THRESH of
 107 *          those in D1.  2*THRESH if they are not.  (Tested using
 108 *          SSTECH)
 109 *
 110 *  For S positive definite,
 111 *
 112 *  (14)    | S - Z4 D4 Z4* | / ( |S| n ulp ) CPTEQR('V',...)
 113 *
 114 *  (15)    | I - Z4 Z4* | / ( n ulp )        CPTEQR('V',...)
 115 *
 116 *  (16)    | D4 - D5 | / ( 100 |D4| ulp )       CPTEQR('N',...)
 117 *
 118 *  When S is also diagonally dominant by the factor gamma < 1,
 119 *
 120 *  (17)    max | D4(i) - WR(i) | / ( |D4(i)| omega ) ,
 121 *           i
 122 *          omega = 2 (2n-1) ULP (1 + 8 gamma**2) / (1 - gamma)**4
 123 *                                               SSTEBZ( 'A', 'E', ...)
 124 *
 125 *  (18)    | WA1 - D3 | / ( |D3| ulp )          SSTEBZ( 'A', 'E', ...)
 126 *
 127 *  (19)    ( max { min | WA2(i)-WA3(j) | } +
 128 *             i     j
 129 *            max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
 130 *             i     j
 131 *                                               SSTEBZ( 'I', 'E', ...)
 132 *
 133 *  (20)    | S - Y WA1 Y* | / ( |S| n ulp )  SSTEBZ, CSTEIN
 134 *
 135 *  (21)    | I - Y Y* | / ( n ulp )          SSTEBZ, CSTEIN
 136 *
 137 *  (22)    | S - Z D Z* | / ( |S| n ulp )    CSTEDC('I')
 138 *
 139 *  (23)    | I - ZZ* | / ( n ulp )           CSTEDC('I')
 140 *
 141 *  (24)    | S - Z D Z* | / ( |S| n ulp )    CSTEDC('V')
 142 *
 143 *  (25)    | I - ZZ* | / ( n ulp )           CSTEDC('V')
 144 *
 145 *  (26)    | D1 - D2 | / ( |D1| ulp )           CSTEDC('V') and
 146 *                                               CSTEDC('N')
 147 *
 148 *  Test 27 is disabled at the moment because CSTEMR does not
 149 *  guarantee high relatvie accuracy.
 150 *
 151 *  (27)    max | D6(i) - WR(i) | / ( |D6(i)| omega ) ,
 152 *           i
 153 *          omega = 2 (2n-1) ULP (1 + 8 gamma**2) / (1 - gamma)**4
 154 *                                               CSTEMR('V', 'A')
 155 *
 156 *  (28)    max | D6(i) - WR(i) | / ( |D6(i)| omega ) ,
 157 *           i
 158 *          omega = 2 (2n-1) ULP (1 + 8 gamma**2) / (1 - gamma)**4
 159 *                                               CSTEMR('V', 'I')
 160 *
 161 *  Tests 29 through 34 are disable at present because CSTEMR
 162 *  does not handle partial specturm requests.
 163 *
 164 *  (29)    | S - Z D Z* | / ( |S| n ulp )    CSTEMR('V', 'I')
 165 *
 166 *  (30)    | I - ZZ* | / ( n ulp )           CSTEMR('V', 'I')
 167 *
 168 *  (31)    ( max { min | WA2(i)-WA3(j) | } +
 169 *             i     j
 170 *            max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
 171 *             i     j
 172 *          CSTEMR('N', 'I') vs. CSTEMR('V', 'I')
 173 *
 174 *  (32)    | S - Z D Z* | / ( |S| n ulp )    CSTEMR('V', 'V')
 175 *
 176 *  (33)    | I - ZZ* | / ( n ulp )           CSTEMR('V', 'V')
 177 *
 178 *  (34)    ( max { min | WA2(i)-WA3(j) | } +
 179 *             i     j
 180 *            max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
 181 *             i     j
 182 *          CSTEMR('N', 'V') vs. CSTEMR('V', 'V')
 183 *
 184 *  (35)    | S - Z D Z* | / ( |S| n ulp )    CSTEMR('V', 'A')
 185 *
 186 *  (36)    | I - ZZ* | / ( n ulp )           CSTEMR('V', 'A')
 187 *
 188 *  (37)    ( max { min | WA2(i)-WA3(j) | } +
 189 *             i     j
 190 *            max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
 191 *             i     j
 192 *          CSTEMR('N', 'A') vs. CSTEMR('V', 'A')
 193 *
 194 *  The "sizes" are specified by an array NN(1:NSIZES); the value of
 195 *  each element NN(j) specifies one size.
 196 *  The "types" are specified by a logical array DOTYPE( 1:NTYPES );
 197 *  if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
 198 *  Currently, the list of possible types is:
 199 *
 200 *  (1)  The zero matrix.
 201 *  (2)  The identity matrix.
 202 *
 203 *  (3)  A diagonal matrix with evenly spaced entries
 204 *       1, ..., ULP  and random signs.
 205 *       (ULP = (first number larger than 1) - 1 )
 206 *  (4)  A diagonal matrix with geometrically spaced entries
 207 *       1, ..., ULP  and random signs.
 208 *  (5)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
 209 *       and random signs.
 210 *
 211 *  (6)  Same as (4), but multiplied by SQRT( overflow threshold )
 212 *  (7)  Same as (4), but multiplied by SQRT( underflow threshold )
 213 *
 214 *  (8)  A matrix of the form  U* D U, where U is unitary and
 215 *       D has evenly spaced entries 1, ..., ULP with random signs
 216 *       on the diagonal.
 217 *
 218 *  (9)  A matrix of the form  U* D U, where U is unitary and
 219 *       D has geometrically spaced entries 1, ..., ULP with random
 220 *       signs on the diagonal.
 221 *
 222 *  (10) A matrix of the form  U* D U, where U is unitary and
 223 *       D has "clustered" entries 1, ULP,..., ULP with random
 224 *       signs on the diagonal.
 225 *
 226 *  (11) Same as (8), but multiplied by SQRT( overflow threshold )
 227 *  (12) Same as (8), but multiplied by SQRT( underflow threshold )
 228 *
 229 *  (13) Hermitian matrix with random entries chosen from (-1,1).
 230 *  (14) Same as (13), but multiplied by SQRT( overflow threshold )
 231 *  (15) Same as (13), but multiplied by SQRT( underflow threshold )
 232 *  (16) Same as (8), but diagonal elements are all positive.
 233 *  (17) Same as (9), but diagonal elements are all positive.
 234 *  (18) Same as (10), but diagonal elements are all positive.
 235 *  (19) Same as (16), but multiplied by SQRT( overflow threshold )
 236 *  (20) Same as (16), but multiplied by SQRT( underflow threshold )
 237 *  (21) A diagonally dominant tridiagonal matrix with geometrically
 238 *       spaced diagonal entries 1, ..., ULP.
 239 *
 240 *  Arguments
 241 *  =========
 242 *
 243 *  NSIZES  (input) INTEGER
 244 *          The number of sizes of matrices to use.  If it is zero,
 245 *          CCHKST does nothing.  It must be at least zero.
 246 *
 247 *  NN      (input) INTEGER array, dimension (NSIZES)
 248 *          An array containing the sizes to be used for the matrices.
 249 *          Zero values will be skipped.  The values must be at least
 250 *          zero.
 251 *
 252 *  NTYPES  (input) INTEGER
 253 *          The number of elements in DOTYPE.   If it is zero, CCHKST
 254 *          does nothing.  It must be at least zero.  If it is MAXTYP+1
 255 *          and NSIZES is 1, then an additional type, MAXTYP+1 is
 256 *          defined, which is to use whatever matrix is in A.  This
 257 *          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
 258 *          DOTYPE(MAXTYP+1) is .TRUE. .
 259 *
 260 *  DOTYPE  (input) LOGICAL array, dimension (NTYPES)
 261 *          If DOTYPE(j) is .TRUE., then for each size in NN a
 262 *          matrix of that size and of type j will be generated.
 263 *          If NTYPES is smaller than the maximum number of types
 264 *          defined (PARAMETER MAXTYP), then types NTYPES+1 through
 265 *          MAXTYP will not be generated.  If NTYPES is larger
 266 *          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
 267 *          will be ignored.
 268 *
 269 *  ISEED   (input/output) INTEGER array, dimension (4)
 270 *          On entry ISEED specifies the seed of the random number
 271 *          generator. The array elements should be between 0 and 4095;
 272 *          if not they will be reduced mod 4096.  Also, ISEED(4) must
 273 *          be odd.  The random number generator uses a linear
 274 *          congruential sequence limited to small integers, and so
 275 *          should produce machine independent random numbers. The
 276 *          values of ISEED are changed on exit, and can be used in the
 277 *          next call to CCHKST to continue the same random number
 278 *          sequence.
 279 *
 280 *  THRESH  (input) REAL
 281 *          A test will count as "failed" if the "error", computed as
 282 *          described above, exceeds THRESH.  Note that the error
 283 *          is scaled to be O(1), so THRESH should be a reasonably
 284 *          small multiple of 1, e.g., 10 or 100.  In particular,
 285 *          it should not depend on the precision (single vs. double)
 286 *          or the size of the matrix.  It must be at least zero.
 287 *
 288 *  NOUNIT  (input) INTEGER
 289 *          The FORTRAN unit number for printing out error messages
 290 *          (e.g., if a routine returns IINFO not equal to 0.)
 291 *
 292 *  A       (input/workspace/output) COMPLEX array of
 293 *                                  dimension ( LDA , max(NN) )
 294 *          Used to hold the matrix whose eigenvalues are to be
 295 *          computed.  On exit, A contains the last matrix actually
 296 *          used.
 297 *
 298 *  LDA     (input) INTEGER
 299 *          The leading dimension of A.  It must be at
 300 *          least 1 and at least max( NN ).
 301 *
 302 *  AP      (workspace) COMPLEX array of
 303 *                      dimension( max(NN)*max(NN+1)/2 )
 304 *          The matrix A stored in packed format.
 305 *
 306 *  SD      (workspace/output) REAL array of
 307 *                             dimension( max(NN) )
 308 *          The diagonal of the tridiagonal matrix computed by CHETRD.
 309 *          On exit, SD and SE contain the tridiagonal form of the
 310 *          matrix in A.
 311 *
 312 *  SE      (workspace/output) REAL array of
 313 *                             dimension( max(NN) )
 314 *          The off-diagonal of the tridiagonal matrix computed by
 315 *          CHETRD.  On exit, SD and SE contain the tridiagonal form of
 316 *          the matrix in A.
 317 *
 318 *  D1      (workspace/output) REAL array of
 319 *                             dimension( max(NN) )
 320 *          The eigenvalues of A, as computed by CSTEQR simlutaneously
 321 *          with Z.  On exit, the eigenvalues in D1 correspond with the
 322 *          matrix in A.
 323 *
 324 *  D2      (workspace/output) REAL array of
 325 *                             dimension( max(NN) )
 326 *          The eigenvalues of A, as computed by CSTEQR if Z is not
 327 *          computed.  On exit, the eigenvalues in D2 correspond with
 328 *          the matrix in A.
 329 *
 330 *  D3      (workspace/output) REAL array of
 331 *                             dimension( max(NN) )
 332 *          The eigenvalues of A, as computed by SSTERF.  On exit, the
 333 *          eigenvalues in D3 correspond with the matrix in A.
 334 *
 335 *  U       (workspace/output) COMPLEX array of
 336 *                             dimension( LDU, max(NN) ).
 337 *          The unitary matrix computed by CHETRD + CUNGTR.
 338 *
 339 *  LDU     (input) INTEGER
 340 *          The leading dimension of U, Z, and V.  It must be at least 1
 341 *          and at least max( NN ).
 342 *
 343 *  V       (workspace/output) COMPLEX array of
 344 *                             dimension( LDU, max(NN) ).
 345 *          The Housholder vectors computed by CHETRD in reducing A to
 346 *          tridiagonal form.  The vectors computed with UPLO='U' are
 347 *          in the upper triangle, and the vectors computed with UPLO='L'
 348 *          are in the lower triangle.  (As described in CHETRD, the
 349 *          sub- and superdiagonal are not set to 1, although the
 350 *          true Householder vector has a 1 in that position.  The
 351 *          routines that use V, such as CUNGTR, set those entries to
 352 *          1 before using them, and then restore them later.)
 353 *
 354 *  VP      (workspace) COMPLEX array of
 355 *                      dimension( max(NN)*max(NN+1)/2 )
 356 *          The matrix V stored in packed format.
 357 *
 358 *  TAU     (workspace/output) COMPLEX array of
 359 *                             dimension( max(NN) )
 360 *          The Householder factors computed by CHETRD in reducing A
 361 *          to tridiagonal form.
 362 *
 363 *  Z       (workspace/output) COMPLEX array of
 364 *                             dimension( LDU, max(NN) ).
 365 *          The unitary matrix of eigenvectors computed by CSTEQR,
 366 *          CPTEQR, and CSTEIN.
 367 *
 368 *  WORK    (workspace/output) COMPLEX array of
 369 *                      dimension( LWORK )
 370 *
 371 *  LWORK   (input) INTEGER
 372 *          The number of entries in WORK.  This must be at least
 373 *          1 + 4 * Nmax + 2 * Nmax * lg Nmax + 3 * Nmax**2
 374 *          where Nmax = max( NN(j), 2 ) and lg = log base 2.
 375 *
 376 *  IWORK   (workspace/output) INTEGER array,
 377 *             dimension (6 + 6*Nmax + 5 * Nmax * lg Nmax )
 378 *          where Nmax = max( NN(j), 2 ) and lg = log base 2.
 379 *          Workspace.
 380 *
 381 *  RWORK   (workspace/output) REAL array of
 382 *                      dimension( ??? )
 383 *
 384 *  RESULT  (output) REAL array, dimension (26)
 385 *          The values computed by the tests described above.
 386 *          The values are currently limited to 1/ulp, to avoid
 387 *          overflow.
 388 *
 389 *  INFO    (output) INTEGER
 390 *          If 0, then everything ran OK.
 391 *           -1: NSIZES < 0
 392 *           -2: Some NN(j) < 0
 393 *           -3: NTYPES < 0
 394 *           -5: THRESH < 0
 395 *           -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
 396 *          -23: LDU < 1 or LDU < NMAX.
 397 *          -29: LWORK too small.
 398 *          If  CLATMR, CLATMS, CHETRD, CUNGTR, CSTEQR, SSTERF,
 399 *              or CUNMC2 returns an error code, the
 400 *              absolute value of it is returned.
 401 *
 402 *-----------------------------------------------------------------------
 403 *
 404 *       Some Local Variables and Parameters:
 405 *       ---- ----- --------- --- ----------
 406 *       ZERO, ONE       Real 0 and 1.
 407 *       MAXTYP          The number of types defined.
 408 *       NTEST           The number of tests performed, or which can
 409 *                       be performed so far, for the current matrix.
 410 *       NTESTT          The total number of tests performed so far.
 411 *       NBLOCK          Blocksize as returned by ENVIR.
 412 *       NMAX            Largest value in NN.
 413 *       NMATS           The number of matrices generated so far.
 414 *       NERRS           The number of tests which have exceeded THRESH
 415 *                       so far.
 416 *       COND, IMODE     Values to be passed to the matrix generators.
 417 *       ANORM           Norm of A; passed to matrix generators.
 418 *
 419 *       OVFL, UNFL      Overflow and underflow thresholds.
 420 *       ULP, ULPINV     Finest relative precision and its inverse.
 421 *       RTOVFL, RTUNFL  Square roots of the previous 2 values.
 422 *               The following four arrays decode JTYPE:
 423 *       KTYPE(j)        The general type (1-10) for type "j".
 424 *       KMODE(j)        The MODE value to be passed to the matrix
 425 *                       generator for type "j".
 426 *       KMAGN(j)        The order of magnitude ( O(1),
 427 *                       O(overflow^(1/2) ), O(underflow^(1/2) )
 428 *
 429 *  =====================================================================
 430 *
 431 *     .. Parameters ..
 432       REAL               ZERO, ONE, TWO, EIGHT, TEN, HUN
 433       PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0,
 434      $                   EIGHT = 8.0E0, TEN = 10.0E0, HUN = 100.0E0 )
 435       COMPLEX            CZERO, CONE
 436       PARAMETER          ( CZERO = ( 0.0E+0, 0.0E+0 ),
 437      $                   CONE = ( 1.0E+0, 0.0E+0 ) )
 438       REAL               HALF
 439       PARAMETER          ( HALF = ONE / TWO )
 440       INTEGER            MAXTYP
 441       PARAMETER          ( MAXTYP = 21 )
 442       LOGICAL            CRANGE
 443       PARAMETER          ( CRANGE = .FALSE. )
 444       LOGICAL            CREL
 445       PARAMETER          ( CREL = .FALSE. )
 446 *     ..
 447 *     .. Local Scalars ..
 448       LOGICAL            BADNN, TRYRAC
 449       INTEGER            I, IINFO, IL, IMODE, INDE, INDRWK, ITEMP,
 450      $                   ITYPE, IU, J, JC, JR, JSIZE, JTYPE, LGN,
 451      $                   LIWEDC, LOG2UI, LRWEDC, LWEDC, M, M2, M3,
 452      $                   MTYPES, N, NAP, NBLOCK, NERRS, NMATS, NMAX,
 453      $                   NSPLIT, NTEST, NTESTT
 454       REAL               ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
 455      $                   RTUNFL, TEMP1, TEMP2, TEMP3, TEMP4, ULP,
 456      $                   ULPINV, UNFL, VL, VU
 457 *     ..
 458 *     .. Local Arrays ..
 459       INTEGER            IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
 460      $                   KMAGN( MAXTYP ), KMODE( MAXTYP ),
 461      $                   KTYPE( MAXTYP )
 462       REAL               DUMMA( 1 )
 463 *     ..
 464 *     .. External Functions ..
 465       INTEGER            ILAENV
 466       REAL               SLAMCH, SLARND, SSXT1
 467       EXTERNAL           ILAENV, SLAMCH, SLARND, SSXT1
 468 *     ..
 469 *     .. External Subroutines ..
 470       EXTERNAL           CCOPY, CHET21, CHETRD, CHPT21, CHPTRD, CLACPY,
 471      $                   CLASET, CLATMR, CLATMS, CPTEQR, CSTEDC, CSTEMR,
 472      $                   CSTEIN, CSTEQR, CSTT21, CSTT22, CUNGTR, CUPGTR,
 473      $                   SCOPY, SLABAD, SLASUM, SSTEBZ, SSTECH, SSTERF,
 474      $                   XERBLA
 475 *     ..
 476 *     .. Intrinsic Functions ..
 477       INTRINSIC          ABS, CONJG, INT, LOG, MAX, MIN, REAL, SQRT
 478 *     ..
 479 *     .. Data statements ..
 480       DATA               KTYPE / 1, 2, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 8,
 481      $                   8, 8, 9, 9, 9, 9, 9, 10 /
 482       DATA               KMAGN / 1, 1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
 483      $                   2, 3, 1, 1, 1, 2, 3, 1 /
 484       DATA               KMODE / 0, 0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
 485      $                   0, 0, 4, 3, 1, 4, 4, 3 /
 486 *     ..
 487 *     .. Executable Statements ..
 488 *
 489 *     Keep ftnchek happy
 490       IDUMMA( 1 ) = 1
 491 *
 492 *     Check for errors
 493 *
 494       NTESTT = 0
 495       INFO = 0
 496 *
 497 *     Important constants
 498 *
 499       BADNN = .FALSE.
 500       TRYRAC = .TRUE.
 501       NMAX = 1
 502       DO 10 J = 1, NSIZES
 503          NMAX = MAX( NMAX, NN( J ) )
 504          IF( NN( J ).LT.0 )
 505      $      BADNN = .TRUE.
 506    10 CONTINUE
 507 *
 508       NBLOCK = ILAENV( 1, 'CHETRD', 'L', NMAX, -1, -1, -1 )
 509       NBLOCK = MIN( NMAX, MAX( 1, NBLOCK ) )
 510 *
 511 *     Check for errors
 512 *
 513       IF( NSIZES.LT.0 ) THEN
 514          INFO = -1
 515       ELSE IF( BADNN ) THEN
 516          INFO = -2
 517       ELSE IF( NTYPES.LT.0 ) THEN
 518          INFO = -3
 519       ELSE IF( LDA.LT.NMAX ) THEN
 520          INFO = -9
 521       ELSE IF( LDU.LT.NMAX ) THEN
 522          INFO = -23
 523       ELSE IF( 2*MAX( 2, NMAX )**2.GT.LWORK ) THEN
 524          INFO = -29
 525       END IF
 526 *
 527       IF( INFO.NE.0 ) THEN
 528          CALL XERBLA( 'CCHKST', -INFO )
 529          RETURN
 530       END IF
 531 *
 532 *     Quick return if possible
 533 *
 534       IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 )
 535      $   RETURN
 536 *
 537 *     More Important constants
 538 *
 539       UNFL = SLAMCH( 'Safe minimum' )
 540       OVFL = ONE / UNFL
 541       CALL SLABAD( UNFL, OVFL )
 542       ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' )
 543       ULPINV = ONE / ULP
 544       LOG2UI = INT( LOG( ULPINV ) / LOG( TWO ) )
 545       RTUNFL = SQRT( UNFL )
 546       RTOVFL = SQRT( OVFL )
 547 *
 548 *     Loop over sizes, types
 549 *
 550       DO 20 I = 1, 4
 551          ISEED2( I ) = ISEED( I )
 552    20 CONTINUE
 553       NERRS = 0
 554       NMATS = 0
 555 *
 556       DO 310 JSIZE = 1, NSIZES
 557          N = NN( JSIZE )
 558          IF( N.GT.0 ) THEN
 559             LGN = INT( LOG( REAL( N ) ) / LOG( TWO ) )
 560             IF( 2**LGN.LT.N )
 561      $         LGN = LGN + 1
 562             IF( 2**LGN.LT.N )
 563      $         LGN = LGN + 1
 564             LWEDC = 1 + 4*N + 2*N*LGN + 3*N**2
 565             LRWEDC = 1 + 3*N + 2*N*LGN + 3*N**2
 566             LIWEDC = 6 + 6*N + 5*N*LGN
 567          ELSE
 568             LWEDC = 8
 569             LRWEDC = 7
 570             LIWEDC = 12
 571          END IF
 572          NAP = ( N*( N+1 ) ) / 2
 573          ANINV = ONE / REAL( MAX( 1, N ) )
 574 *
 575          IF( NSIZES.NE.1 ) THEN
 576             MTYPES = MIN( MAXTYP, NTYPES )
 577          ELSE
 578             MTYPES = MIN( MAXTYP+1, NTYPES )
 579          END IF
 580 *
 581          DO 300 JTYPE = 1, MTYPES
 582             IF( .NOT.DOTYPE( JTYPE ) )
 583      $         GO TO 300
 584             NMATS = NMATS + 1
 585             NTEST = 0
 586 *
 587             DO 30 J = 1, 4
 588                IOLDSD( J ) = ISEED( J )
 589    30       CONTINUE
 590 *
 591 *           Compute "A"
 592 *
 593 *           Control parameters:
 594 *
 595 *               KMAGN  KMODE        KTYPE
 596 *           =1  O(1)   clustered 1  zero
 597 *           =2  large  clustered 2  identity
 598 *           =3  small  exponential  (none)
 599 *           =4         arithmetic   diagonal, (w/ eigenvalues)
 600 *           =5         random log   Hermitian, w/ eigenvalues
 601 *           =6         random       (none)
 602 *           =7                      random diagonal
 603 *           =8                      random Hermitian
 604 *           =9                      positive definite
 605 *           =10                     diagonally dominant tridiagonal
 606 *
 607             IF( MTYPES.GT.MAXTYP )
 608      $         GO TO 100
 609 *
 610             ITYPE = KTYPE( JTYPE )
 611             IMODE = KMODE( JTYPE )
 612 *
 613 *           Compute norm
 614 *
 615             GO TO ( 40, 50, 60 )KMAGN( JTYPE )
 616 *
 617    40       CONTINUE
 618             ANORM = ONE
 619             GO TO 70
 620 *
 621    50       CONTINUE
 622             ANORM = ( RTOVFL*ULP )*ANINV
 623             GO TO 70
 624 *
 625    60       CONTINUE
 626             ANORM = RTUNFL*N*ULPINV
 627             GO TO 70
 628 *
 629    70       CONTINUE
 630 *
 631             CALL CLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
 632             IINFO = 0
 633             IF( JTYPE.LE.15 ) THEN
 634                COND = ULPINV
 635             ELSE
 636                COND = ULPINV*ANINV / TEN
 637             END IF
 638 *
 639 *           Special Matrices -- Identity & Jordan block
 640 *
 641 *              Zero
 642 *
 643             IF( ITYPE.EQ.1 ) THEN
 644                IINFO = 0
 645 *
 646             ELSE IF( ITYPE.EQ.2 ) THEN
 647 *
 648 *              Identity
 649 *
 650                DO 80 JC = 1, N
 651                   A( JC, JC ) = ANORM
 652    80          CONTINUE
 653 *
 654             ELSE IF( ITYPE.EQ.4 ) THEN
 655 *
 656 *              Diagonal Matrix, [Eigen]values Specified
 657 *
 658                CALL CLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
 659      $                      ANORM, 0, 0, 'N', A, LDA, WORK, IINFO )
 660 *
 661 *
 662             ELSE IF( ITYPE.EQ.5 ) THEN
 663 *
 664 *              Hermitian, eigenvalues specified
 665 *
 666                CALL CLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
 667      $                      ANORM, N, N, 'N', A, LDA, WORK, IINFO )
 668 *
 669             ELSE IF( ITYPE.EQ.7 ) THEN
 670 *
 671 *              Diagonal, random eigenvalues
 672 *
 673                CALL CLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE,
 674      $                      'T', 'N', WORK( N+1 ), 1, ONE,
 675      $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
 676      $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
 677 *
 678             ELSE IF( ITYPE.EQ.8 ) THEN
 679 *
 680 *              Hermitian, random eigenvalues
 681 *
 682                CALL CLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE,
 683      $                      'T', 'N', WORK( N+1 ), 1, ONE,
 684      $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N,
 685      $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
 686 *
 687             ELSE IF( ITYPE.EQ.9 ) THEN
 688 *
 689 *              Positive definite, eigenvalues specified.
 690 *
 691                CALL CLATMS( N, N, 'S', ISEED, 'P', RWORK, IMODE, COND,
 692      $                      ANORM, N, N, 'N', A, LDA, WORK, IINFO )
 693 *
 694             ELSE IF( ITYPE.EQ.10 ) THEN
 695 *
 696 *              Positive definite tridiagonal, eigenvalues specified.
 697 *
 698                CALL CLATMS( N, N, 'S', ISEED, 'P', RWORK, IMODE, COND,
 699      $                      ANORM, 1, 1, 'N', A, LDA, WORK, IINFO )
 700                DO 90 I = 2, N
 701                   TEMP1 = ABS( A( I-1, I ) )
 702                   TEMP2 = SQRT( ABS( A( I-1, I-1 )*A( I, I ) ) )
 703                   IF( TEMP1.GT.HALF*TEMP2 ) THEN
 704                      A( I-1, I ) = A( I-1, I )*
 705      $                             ( HALF*TEMP2 / ( UNFL+TEMP1 ) )
 706                      A( I, I-1 ) = CONJG( A( I-1, I ) )
 707                   END IF
 708    90          CONTINUE
 709 *
 710             ELSE
 711 *
 712                IINFO = 1
 713             END IF
 714 *
 715             IF( IINFO.NE.0 ) THEN
 716                WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE,
 717      $            IOLDSD
 718                INFO = ABS( IINFO )
 719                RETURN
 720             END IF
 721 *
 722   100       CONTINUE
 723 *
 724 *           Call CHETRD and CUNGTR to compute S and U from
 725 *           upper triangle.
 726 *
 727             CALL CLACPY( 'U', N, N, A, LDA, V, LDU )
 728 *
 729             NTEST = 1
 730             CALL CHETRD( 'U', N, V, LDU, SD, SE, TAU, WORK, LWORK,
 731      $                   IINFO )
 732 *
 733             IF( IINFO.NE.0 ) THEN
 734                WRITE( NOUNIT, FMT = 9999 )'CHETRD(U)', IINFO, N, JTYPE,
 735      $            IOLDSD
 736                INFO = ABS( IINFO )
 737                IF( IINFO.LT.0 ) THEN
 738                   RETURN
 739                ELSE
 740                   RESULT( 1 ) = ULPINV
 741                   GO TO 280
 742                END IF
 743             END IF
 744 *
 745             CALL CLACPY( 'U', N, N, V, LDU, U, LDU )
 746 *
 747             NTEST = 2
 748             CALL CUNGTR( 'U', N, U, LDU, TAU, WORK, LWORK, IINFO )
 749             IF( IINFO.NE.0 ) THEN
 750                WRITE( NOUNIT, FMT = 9999 )'CUNGTR(U)', IINFO, N, JTYPE,
 751      $            IOLDSD
 752                INFO = ABS( IINFO )
 753                IF( IINFO.LT.0 ) THEN
 754                   RETURN
 755                ELSE
 756                   RESULT( 2 ) = ULPINV
 757                   GO TO 280
 758                END IF
 759             END IF
 760 *
 761 *           Do tests 1 and 2
 762 *
 763             CALL CHET21( 2, 'Upper', N, 1, A, LDA, SD, SE, U, LDU, V,
 764      $                   LDU, TAU, WORK, RWORK, RESULT( 1 ) )
 765             CALL CHET21( 3, 'Upper', N, 1, A, LDA, SD, SE, U, LDU, V,
 766      $                   LDU, TAU, WORK, RWORK, RESULT( 2 ) )
 767 *
 768 *           Call CHETRD and CUNGTR to compute S and U from
 769 *           lower triangle, do tests.
 770 *
 771             CALL CLACPY( 'L', N, N, A, LDA, V, LDU )
 772 *
 773             NTEST = 3
 774             CALL CHETRD( 'L', N, V, LDU, SD, SE, TAU, WORK, LWORK,
 775      $                   IINFO )
 776 *
 777             IF( IINFO.NE.0 ) THEN
 778                WRITE( NOUNIT, FMT = 9999 )'CHETRD(L)', IINFO, N, JTYPE,
 779      $            IOLDSD
 780                INFO = ABS( IINFO )
 781                IF( IINFO.LT.0 ) THEN
 782                   RETURN
 783                ELSE
 784                   RESULT( 3 ) = ULPINV
 785                   GO TO 280
 786                END IF
 787             END IF
 788 *
 789             CALL CLACPY( 'L', N, N, V, LDU, U, LDU )
 790 *
 791             NTEST = 4
 792             CALL CUNGTR( 'L', N, U, LDU, TAU, WORK, LWORK, IINFO )
 793             IF( IINFO.NE.0 ) THEN
 794                WRITE( NOUNIT, FMT = 9999 )'CUNGTR(L)', IINFO, N, JTYPE,
 795      $            IOLDSD
 796                INFO = ABS( IINFO )
 797                IF( IINFO.LT.0 ) THEN
 798                   RETURN
 799                ELSE
 800                   RESULT( 4 ) = ULPINV
 801                   GO TO 280
 802                END IF
 803             END IF
 804 *
 805             CALL CHET21( 2, 'Lower', N, 1, A, LDA, SD, SE, U, LDU, V,
 806      $                   LDU, TAU, WORK, RWORK, RESULT( 3 ) )
 807             CALL CHET21( 3, 'Lower', N, 1, A, LDA, SD, SE, U, LDU, V,
 808      $                   LDU, TAU, WORK, RWORK, RESULT( 4 ) )
 809 *
 810 *           Store the upper triangle of A in AP
 811 *
 812             I = 0
 813             DO 120 JC = 1, N
 814                DO 110 JR = 1, JC
 815                   I = I + 1
 816                   AP( I ) = A( JR, JC )
 817   110          CONTINUE
 818   120       CONTINUE
 819 *
 820 *           Call CHPTRD and CUPGTR to compute S and U from AP
 821 *
 822             CALL CCOPY( NAP, AP, 1, VP, 1 )
 823 *
 824             NTEST = 5
 825             CALL CHPTRD( 'U', N, VP, SD, SE, TAU, IINFO )
 826 *
 827             IF( IINFO.NE.0 ) THEN
 828                WRITE( NOUNIT, FMT = 9999 )'CHPTRD(U)', IINFO, N, JTYPE,
 829      $            IOLDSD
 830                INFO = ABS( IINFO )
 831                IF( IINFO.LT.0 ) THEN
 832                   RETURN
 833                ELSE
 834                   RESULT( 5 ) = ULPINV
 835                   GO TO 280
 836                END IF
 837             END IF
 838 *
 839             NTEST = 6
 840             CALL CUPGTR( 'U', N, VP, TAU, U, LDU, WORK, IINFO )
 841             IF( IINFO.NE.0 ) THEN
 842                WRITE( NOUNIT, FMT = 9999 )'CUPGTR(U)', IINFO, N, JTYPE,
 843      $            IOLDSD
 844                INFO = ABS( IINFO )
 845                IF( IINFO.LT.0 ) THEN
 846                   RETURN
 847                ELSE
 848                   RESULT( 6 ) = ULPINV
 849                   GO TO 280
 850                END IF
 851             END IF
 852 *
 853 *           Do tests 5 and 6
 854 *
 855             CALL CHPT21( 2, 'Upper', N, 1, AP, SD, SE, U, LDU, VP, TAU,
 856      $                   WORK, RWORK, RESULT( 5 ) )
 857             CALL CHPT21( 3, 'Upper', N, 1, AP, SD, SE, U, LDU, VP, TAU,
 858      $                   WORK, RWORK, RESULT( 6 ) )
 859 *
 860 *           Store the lower triangle of A in AP
 861 *
 862             I = 0
 863             DO 140 JC = 1, N
 864                DO 130 JR = JC, N
 865                   I = I + 1
 866                   AP( I ) = A( JR, JC )
 867   130          CONTINUE
 868   140       CONTINUE
 869 *
 870 *           Call CHPTRD and CUPGTR to compute S and U from AP
 871 *
 872             CALL CCOPY( NAP, AP, 1, VP, 1 )
 873 *
 874             NTEST = 7
 875             CALL CHPTRD( 'L', N, VP, SD, SE, TAU, IINFO )
 876 *
 877             IF( IINFO.NE.0 ) THEN
 878                WRITE( NOUNIT, FMT = 9999 )'CHPTRD(L)', IINFO, N, JTYPE,
 879      $            IOLDSD
 880                INFO = ABS( IINFO )
 881                IF( IINFO.LT.0 ) THEN
 882                   RETURN
 883                ELSE
 884                   RESULT( 7 ) = ULPINV
 885                   GO TO 280
 886                END IF
 887             END IF
 888 *
 889             NTEST = 8
 890             CALL CUPGTR( 'L', N, VP, TAU, U, LDU, WORK, IINFO )
 891             IF( IINFO.NE.0 ) THEN
 892                WRITE( NOUNIT, FMT = 9999 )'CUPGTR(L)', IINFO, N, JTYPE,
 893      $            IOLDSD
 894                INFO = ABS( IINFO )
 895                IF( IINFO.LT.0 ) THEN
 896                   RETURN
 897                ELSE
 898                   RESULT( 8 ) = ULPINV
 899                   GO TO 280
 900                END IF
 901             END IF
 902 *
 903             CALL CHPT21( 2, 'Lower', N, 1, AP, SD, SE, U, LDU, VP, TAU,
 904      $                   WORK, RWORK, RESULT( 7 ) )
 905             CALL CHPT21( 3, 'Lower', N, 1, AP, SD, SE, U, LDU, VP, TAU,
 906      $                   WORK, RWORK, RESULT( 8 ) )
 907 *
 908 *           Call CSTEQR to compute D1, D2, and Z, do tests.
 909 *
 910 *           Compute D1 and Z
 911 *
 912             CALL SCOPY( N, SD, 1, D1, 1 )
 913             IF( N.GT.0 )
 914      $         CALL SCOPY( N-1, SE, 1, RWORK, 1 )
 915             CALL CLASET( 'Full', N, N, CZERO, CONE, Z, LDU )
 916 *
 917             NTEST = 9
 918             CALL CSTEQR( 'V', N, D1, RWORK, Z, LDU, RWORK( N+1 ),
 919      $                   IINFO )
 920             IF( IINFO.NE.0 ) THEN
 921                WRITE( NOUNIT, FMT = 9999 )'CSTEQR(V)', IINFO, N, JTYPE,
 922      $            IOLDSD
 923                INFO = ABS( IINFO )
 924                IF( IINFO.LT.0 ) THEN
 925                   RETURN
 926                ELSE
 927                   RESULT( 9 ) = ULPINV
 928                   GO TO 280
 929                END IF
 930             END IF
 931 *
 932 *           Compute D2
 933 *
 934             CALL SCOPY( N, SD, 1, D2, 1 )
 935             IF( N.GT.0 )
 936      $         CALL SCOPY( N-1, SE, 1, RWORK, 1 )
 937 *
 938             NTEST = 11
 939             CALL CSTEQR( 'N', N, D2, RWORK, WORK, LDU, RWORK( N+1 ),
 940      $                   IINFO )
 941             IF( IINFO.NE.0 ) THEN
 942                WRITE( NOUNIT, FMT = 9999 )'CSTEQR(N)', IINFO, N, JTYPE,
 943      $            IOLDSD
 944                INFO = ABS( IINFO )
 945                IF( IINFO.LT.0 ) THEN
 946                   RETURN
 947                ELSE
 948                   RESULT( 11 ) = ULPINV
 949                   GO TO 280
 950                END IF
 951             END IF
 952 *
 953 *           Compute D3 (using PWK method)
 954 *
 955             CALL SCOPY( N, SD, 1, D3, 1 )
 956             IF( N.GT.0 )
 957      $         CALL SCOPY( N-1, SE, 1, RWORK, 1 )
 958 *
 959             NTEST = 12
 960             CALL SSTERF( N, D3, RWORK, IINFO )
 961             IF( IINFO.NE.0 ) THEN
 962                WRITE( NOUNIT, FMT = 9999 )'SSTERF', IINFO, N, JTYPE,
 963      $            IOLDSD
 964                INFO = ABS( IINFO )
 965                IF( IINFO.LT.0 ) THEN
 966                   RETURN
 967                ELSE
 968                   RESULT( 12 ) = ULPINV
 969                   GO TO 280
 970                END IF
 971             END IF
 972 *
 973 *           Do Tests 9 and 10
 974 *
 975             CALL CSTT21( N, 0, SD, SE, D1, DUMMA, Z, LDU, WORK, RWORK,
 976      $                   RESULT( 9 ) )
 977 *
 978 *           Do Tests 11 and 12
 979 *
 980             TEMP1 = ZERO
 981             TEMP2 = ZERO
 982             TEMP3 = ZERO
 983             TEMP4 = ZERO
 984 *
 985             DO 150 J = 1, N
 986                TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D2( J ) ) )
 987                TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
 988                TEMP3 = MAX( TEMP3, ABS( D1( J ) ), ABS( D3( J ) ) )
 989                TEMP4 = MAX( TEMP4, ABS( D1( J )-D3( J ) ) )
 990   150       CONTINUE
 991 *
 992             RESULT( 11 ) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
 993             RESULT( 12 ) = TEMP4 / MAX( UNFL, ULP*MAX( TEMP3, TEMP4 ) )
 994 *
 995 *           Do Test 13 -- Sturm Sequence Test of Eigenvalues
 996 *                         Go up by factors of two until it succeeds
 997 *
 998             NTEST = 13
 999             TEMP1 = THRESH*( HALF-ULP )
1000 *
1001             DO 160 J = 0, LOG2UI
1002                CALL SSTECH( N, SD, SE, D1, TEMP1, RWORK, IINFO )
1003                IF( IINFO.EQ.0 )
1004      $            GO TO 170
1005                TEMP1 = TEMP1*TWO
1006   160       CONTINUE
1007 *
1008   170       CONTINUE
1009             RESULT( 13 ) = TEMP1
1010 *
1011 *           For positive definite matrices ( JTYPE.GT.15 ) call CPTEQR
1012 *           and do tests 14, 15, and 16 .
1013 *
1014             IF( JTYPE.GT.15 ) THEN
1015 *
1016 *              Compute D4 and Z4
1017 *
1018                CALL SCOPY( N, SD, 1, D4, 1 )
1019                IF( N.GT.0 )
1020      $            CALL SCOPY( N-1, SE, 1, RWORK, 1 )
1021                CALL CLASET( 'Full', N, N, CZERO, CONE, Z, LDU )
1022 *
1023                NTEST = 14
1024                CALL CPTEQR( 'V', N, D4, RWORK, Z, LDU, RWORK( N+1 ),
1025      $                      IINFO )
1026                IF( IINFO.NE.0 ) THEN
1027                   WRITE( NOUNIT, FMT = 9999 )'CPTEQR(V)', IINFO, N,
1028      $               JTYPE, IOLDSD
1029                   INFO = ABS( IINFO )
1030                   IF( IINFO.LT.0 ) THEN
1031                      RETURN
1032                   ELSE
1033                      RESULT( 14 ) = ULPINV
1034                      GO TO 280
1035                   END IF
1036                END IF
1037 *
1038 *              Do Tests 14 and 15
1039 *
1040                CALL CSTT21( N, 0, SD, SE, D4, DUMMA, Z, LDU, WORK,
1041      $                      RWORK, RESULT( 14 ) )
1042 *
1043 *              Compute D5
1044 *
1045                CALL SCOPY( N, SD, 1, D5, 1 )
1046                IF( N.GT.0 )
1047      $            CALL SCOPY( N-1, SE, 1, RWORK, 1 )
1048 *
1049                NTEST = 16
1050                CALL CPTEQR( 'N', N, D5, RWORK, Z, LDU, RWORK( N+1 ),
1051      $                      IINFO )
1052                IF( IINFO.NE.0 ) THEN
1053                   WRITE( NOUNIT, FMT = 9999 )'CPTEQR(N)', IINFO, N,
1054      $               JTYPE, IOLDSD
1055                   INFO = ABS( IINFO )
1056                   IF( IINFO.LT.0 ) THEN
1057                      RETURN
1058                   ELSE
1059                      RESULT( 16 ) = ULPINV
1060                      GO TO 280
1061                   END IF
1062                END IF
1063 *
1064 *              Do Test 16
1065 *
1066                TEMP1 = ZERO
1067                TEMP2 = ZERO
1068                DO 180 J = 1, N
1069                   TEMP1 = MAX( TEMP1, ABS( D4( J ) ), ABS( D5( J ) ) )
1070                   TEMP2 = MAX( TEMP2, ABS( D4( J )-D5( J ) ) )
1071   180          CONTINUE
1072 *
1073                RESULT( 16 ) = TEMP2 / MAX( UNFL,
1074      $                        HUN*ULP*MAX( TEMP1, TEMP2 ) )
1075             ELSE
1076                RESULT( 14 ) = ZERO
1077                RESULT( 15 ) = ZERO
1078                RESULT( 16 ) = ZERO
1079             END IF
1080 *
1081 *           Call SSTEBZ with different options and do tests 17-18.
1082 *
1083 *              If S is positive definite and diagonally dominant,
1084 *              ask for all eigenvalues with high relative accuracy.
1085 *
1086             VL = ZERO
1087             VU = ZERO
1088             IL = 0
1089             IU = 0
1090             IF( JTYPE.EQ.21 ) THEN
1091                NTEST = 17
1092                ABSTOL = UNFL + UNFL
1093                CALL SSTEBZ( 'A', 'E', N, VL, VU, IL, IU, ABSTOL, SD, SE,
1094      $                      M, NSPLIT, WR, IWORK( 1 ), IWORK( N+1 ),
1095      $                      RWORK, IWORK( 2*N+1 ), IINFO )
1096                IF( IINFO.NE.0 ) THEN
1097                   WRITE( NOUNIT, FMT = 9999 )'SSTEBZ(A,rel)', IINFO, N,
1098      $               JTYPE, IOLDSD
1099                   INFO = ABS( IINFO )
1100                   IF( IINFO.LT.0 ) THEN
1101                      RETURN
1102                   ELSE
1103                      RESULT( 17 ) = ULPINV
1104                      GO TO 280
1105                   END IF
1106                END IF
1107 *
1108 *              Do test 17
1109 *
1110                TEMP2 = TWO*( TWO*N-ONE )*ULP*( ONE+EIGHT*HALF**2 ) /
1111      $                 ( ONE-HALF )**4
1112 *
1113                TEMP1 = ZERO
1114                DO 190 J = 1, N
1115                   TEMP1 = MAX( TEMP1, ABS( D4( J )-WR( N-J+1 ) ) /
1116      $                    ( ABSTOL+ABS( D4( J ) ) ) )
1117   190          CONTINUE
1118 *
1119                RESULT( 17 ) = TEMP1 / TEMP2
1120             ELSE
1121                RESULT( 17 ) = ZERO
1122             END IF
1123 *
1124 *           Now ask for all eigenvalues with high absolute accuracy.
1125 *
1126             NTEST = 18
1127             ABSTOL = UNFL + UNFL
1128             CALL SSTEBZ( 'A', 'E', N, VL, VU, IL, IU, ABSTOL, SD, SE, M,
1129      $                   NSPLIT, WA1, IWORK( 1 ), IWORK( N+1 ), RWORK,
1130      $                   IWORK( 2*N+1 ), IINFO )
1131             IF( IINFO.NE.0 ) THEN
1132                WRITE( NOUNIT, FMT = 9999 )'SSTEBZ(A)', IINFO, N, JTYPE,
1133      $            IOLDSD
1134                INFO = ABS( IINFO )
1135                IF( IINFO.LT.0 ) THEN
1136                   RETURN
1137                ELSE
1138                   RESULT( 18 ) = ULPINV
1139                   GO TO 280
1140                END IF
1141             END IF
1142 *
1143 *           Do test 18
1144 *
1145             TEMP1 = ZERO
1146             TEMP2 = ZERO
1147             DO 200 J = 1, N
1148                TEMP1 = MAX( TEMP1, ABS( D3( J ) ), ABS( WA1( J ) ) )
1149                TEMP2 = MAX( TEMP2, ABS( D3( J )-WA1( J ) ) )
1150   200       CONTINUE
1151 *
1152             RESULT( 18 ) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
1153 *
1154 *           Choose random values for IL and IU, and ask for the
1155 *           IL-th through IU-th eigenvalues.
1156 *
1157             NTEST = 19
1158             IF( N.LE.1 ) THEN
1159                IL = 1
1160                IU = N
1161             ELSE
1162                IL = 1 + ( N-1 )*INT( SLARND( 1, ISEED2 ) )
1163                IU = 1 + ( N-1 )*INT( SLARND( 1, ISEED2 ) )
1164                IF( IU.LT.IL ) THEN
1165                   ITEMP = IU
1166                   IU = IL
1167                   IL = ITEMP
1168                END IF
1169             END IF
1170 *
1171             CALL SSTEBZ( 'I', 'E', N, VL, VU, IL, IU, ABSTOL, SD, SE,
1172      $                   M2, NSPLIT, WA2, IWORK( 1 ), IWORK( N+1 ),
1173      $                   RWORK, IWORK( 2*N+1 ), IINFO )
1174             IF( IINFO.NE.0 ) THEN
1175                WRITE( NOUNIT, FMT = 9999 )'SSTEBZ(I)', IINFO, N, JTYPE,
1176      $            IOLDSD
1177                INFO = ABS( IINFO )
1178                IF( IINFO.LT.0 ) THEN
1179                   RETURN
1180                ELSE
1181                   RESULT( 19 ) = ULPINV
1182                   GO TO 280
1183                END IF
1184             END IF
1185 *
1186 *           Determine the values VL and VU of the IL-th and IU-th
1187 *           eigenvalues and ask for all eigenvalues in this range.
1188 *
1189             IF( N.GT.0 ) THEN
1190                IF( IL.NE.1 ) THEN
1191                   VL = WA1( IL ) - MAX( HALF*( WA1( IL )-WA1( IL-1 ) ),
1192      $                 ULP*ANORM, TWO*RTUNFL )
1193                ELSE
1194                   VL = WA1( 1 ) - MAX( HALF*( WA1( N )-WA1( 1 ) ),
1195      $                 ULP*ANORM, TWO*RTUNFL )
1196                END IF
1197                IF( IU.NE.N ) THEN
1198                   VU = WA1( IU ) + MAX( HALF*( WA1( IU+1 )-WA1( IU ) ),
1199      $                 ULP*ANORM, TWO*RTUNFL )
1200                ELSE
1201                   VU = WA1( N ) + MAX( HALF*( WA1( N )-WA1( 1 ) ),
1202      $                 ULP*ANORM, TWO*RTUNFL )
1203                END IF
1204             ELSE
1205                VL = ZERO
1206                VU = ONE
1207             END IF
1208 *
1209             CALL SSTEBZ( 'V', 'E', N, VL, VU, IL, IU, ABSTOL, SD, SE,
1210      $                   M3, NSPLIT, WA3, IWORK( 1 ), IWORK( N+1 ),
1211      $                   RWORK, IWORK( 2*N+1 ), IINFO )
1212             IF( IINFO.NE.0 ) THEN
1213                WRITE( NOUNIT, FMT = 9999 )'SSTEBZ(V)', IINFO, N, JTYPE,
1214      $            IOLDSD
1215                INFO = ABS( IINFO )
1216                IF( IINFO.LT.0 ) THEN
1217                   RETURN
1218                ELSE
1219                   RESULT( 19 ) = ULPINV
1220                   GO TO 280
1221                END IF
1222             END IF
1223 *
1224             IF( M3.EQ.0 .AND. N.NE.0 ) THEN
1225                RESULT( 19 ) = ULPINV
1226                GO TO 280
1227             END IF
1228 *
1229 *           Do test 19
1230 *
1231             TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
1232             TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
1233             IF( N.GT.0 ) THEN
1234                TEMP3 = MAX( ABS( WA1( N ) ), ABS( WA1( 1 ) ) )
1235             ELSE
1236                TEMP3 = ZERO
1237             END IF
1238 *
1239             RESULT( 19 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, TEMP3*ULP )
1240 *
1241 *           Call CSTEIN to compute eigenvectors corresponding to
1242 *           eigenvalues in WA1.  (First call SSTEBZ again, to make sure
1243 *           it returns these eigenvalues in the correct order.)
1244 *
1245             NTEST = 21
1246             CALL SSTEBZ( 'A', 'B', N, VL, VU, IL, IU, ABSTOL, SD, SE, M,
1247      $                   NSPLIT, WA1, IWORK( 1 ), IWORK( N+1 ), RWORK,
1248      $                   IWORK( 2*N+1 ), IINFO )
1249             IF( IINFO.NE.0 ) THEN
1250                WRITE( NOUNIT, FMT = 9999 )'SSTEBZ(A,B)', IINFO, N,
1251      $            JTYPE, IOLDSD
1252                INFO = ABS( IINFO )
1253                IF( IINFO.LT.0 ) THEN
1254                   RETURN
1255                ELSE
1256                   RESULT( 20 ) = ULPINV
1257                   RESULT( 21 ) = ULPINV
1258                   GO TO 280
1259                END IF
1260             END IF
1261 *
1262             CALL CSTEIN( N, SD, SE, M, WA1, IWORK( 1 ), IWORK( N+1 ), Z,
1263      $                   LDU, RWORK, IWORK( 2*N+1 ), IWORK( 3*N+1 ),
1264      $                   IINFO )
1265             IF( IINFO.NE.0 ) THEN
1266                WRITE( NOUNIT, FMT = 9999 )'CSTEIN', IINFO, N, JTYPE,
1267      $            IOLDSD
1268                INFO = ABS( IINFO )
1269                IF( IINFO.LT.0 ) THEN
1270                   RETURN
1271                ELSE
1272                   RESULT( 20 ) = ULPINV
1273                   RESULT( 21 ) = ULPINV
1274                   GO TO 280
1275                END IF
1276             END IF
1277 *
1278 *           Do tests 20 and 21
1279 *
1280             CALL CSTT21( N, 0, SD, SE, WA1, DUMMA, Z, LDU, WORK, RWORK,
1281      $                   RESULT( 20 ) )
1282 *
1283 *           Call CSTEDC(I) to compute D1 and Z, do tests.
1284 *
1285 *           Compute D1 and Z
1286 *
1287             INDE = 1
1288             INDRWK = INDE + N
1289             CALL SCOPY( N, SD, 1, D1, 1 )
1290             IF( N.GT.0 )
1291      $         CALL SCOPY( N-1, SE, 1, RWORK( INDE ), 1 )
1292             CALL CLASET( 'Full', N, N, CZERO, CONE, Z, LDU )
1293 *
1294             NTEST = 22
1295             CALL CSTEDC( 'I', N, D1, RWORK( INDE ), Z, LDU, WORK, LWEDC,
1296      $                   RWORK( INDRWK ), LRWEDC, IWORK, LIWEDC, IINFO )
1297             IF( IINFO.NE.0 ) THEN
1298                WRITE( NOUNIT, FMT = 9999 )'CSTEDC(I)', IINFO, N, JTYPE,
1299      $            IOLDSD
1300                INFO = ABS( IINFO )
1301                IF( IINFO.LT.0 ) THEN
1302                   RETURN
1303                ELSE
1304                   RESULT( 22 ) = ULPINV
1305                   GO TO 280
1306                END IF
1307             END IF
1308 *
1309 *           Do Tests 22 and 23
1310 *
1311             CALL CSTT21( N, 0, SD, SE, D1, DUMMA, Z, LDU, WORK, RWORK,
1312      $                   RESULT( 22 ) )
1313 *
1314 *           Call CSTEDC(V) to compute D1 and Z, do tests.
1315 *
1316 *           Compute D1 and Z
1317 *
1318             CALL SCOPY( N, SD, 1, D1, 1 )
1319             IF( N.GT.0 )
1320      $         CALL SCOPY( N-1, SE, 1, RWORK( INDE ), 1 )
1321             CALL CLASET( 'Full', N, N, CZERO, CONE, Z, LDU )
1322 *
1323             NTEST = 24
1324             CALL CSTEDC( 'V', N, D1, RWORK( INDE ), Z, LDU, WORK, LWEDC,
1325      $                   RWORK( INDRWK ), LRWEDC, IWORK, LIWEDC, IINFO )
1326             IF( IINFO.NE.0 ) THEN
1327                WRITE( NOUNIT, FMT = 9999 )'CSTEDC(V)', IINFO, N, JTYPE,
1328      $            IOLDSD
1329                INFO = ABS( IINFO )
1330                IF( IINFO.LT.0 ) THEN
1331                   RETURN
1332                ELSE
1333                   RESULT( 24 ) = ULPINV
1334                   GO TO 280
1335                END IF
1336             END IF
1337 *
1338 *           Do Tests 24 and 25
1339 *
1340             CALL CSTT21( N, 0, SD, SE, D1, DUMMA, Z, LDU, WORK, RWORK,
1341      $                   RESULT( 24 ) )
1342 *
1343 *           Call CSTEDC(N) to compute D2, do tests.
1344 *
1345 *           Compute D2
1346 *
1347             CALL SCOPY( N, SD, 1, D2, 1 )
1348             IF( N.GT.0 )
1349      $         CALL SCOPY( N-1, SE, 1, RWORK( INDE ), 1 )
1350             CALL CLASET( 'Full', N, N, CZERO, CONE, Z, LDU )
1351 *
1352             NTEST = 26
1353             CALL CSTEDC( 'N', N, D2, RWORK( INDE ), Z, LDU, WORK, LWEDC,
1354      $                   RWORK( INDRWK ), LRWEDC, IWORK, LIWEDC, IINFO )
1355             IF( IINFO.NE.0 ) THEN
1356                WRITE( NOUNIT, FMT = 9999 )'CSTEDC(N)', IINFO, N, JTYPE,
1357      $            IOLDSD
1358                INFO = ABS( IINFO )
1359                IF( IINFO.LT.0 ) THEN
1360                   RETURN
1361                ELSE
1362                   RESULT( 26 ) = ULPINV
1363                   GO TO 280
1364                END IF
1365             END IF
1366 *
1367 *           Do Test 26
1368 *
1369             TEMP1 = ZERO
1370             TEMP2 = ZERO
1371 *
1372             DO 210 J = 1, N
1373                TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D2( J ) ) )
1374                TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
1375   210       CONTINUE
1376 *
1377             RESULT( 26 ) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
1378 *
1379 *           Only test CSTEMR if IEEE compliant
1380 *
1381             IF( ILAENV( 10, 'CSTEMR', 'VA', 1, 0, 0, 0 ).EQ.1 .AND.
1382      $          ILAENV( 11, 'CSTEMR', 'VA', 1, 0, 0, 0 ).EQ.1 ) THEN
1383 *
1384 *           Call CSTEMR, do test 27 (relative eigenvalue accuracy)
1385 *
1386 *              If S is positive definite and diagonally dominant,
1387 *              ask for all eigenvalues with high relative accuracy.
1388 *
1389                VL = ZERO
1390                VU = ZERO
1391                IL = 0
1392                IU = 0
1393                IF( JTYPE.EQ.21 .AND. CREL ) THEN
1394                   NTEST = 27
1395                   ABSTOL = UNFL + UNFL
1396                   CALL CSTEMR( 'V', 'A', N, SD, SE, VL, VU, IL, IU,
1397      $                         M, WR, Z, LDU, N, IWORK( 1 ), TRYRAC,
1398      $                         RWORK, LRWORK, IWORK( 2*N+1 ), LWORK-2*N,
1399      $                         IINFO )
1400                   IF( IINFO.NE.0 ) THEN
1401                      WRITE( NOUNIT, FMT = 9999 )'CSTEMR(V,A,rel)',
1402      $                  IINFO, N, JTYPE, IOLDSD
1403                      INFO = ABS( IINFO )
1404                      IF( IINFO.LT.0 ) THEN
1405                         RETURN
1406                      ELSE
1407                         RESULT( 27 ) = ULPINV
1408                         GO TO 270
1409                      END IF
1410                   END IF
1411 *
1412 *              Do test 27
1413 *
1414                   TEMP2 = TWO*( TWO*N-ONE )*ULP*( ONE+EIGHT*HALF**2 ) /
1415      $                    ( ONE-HALF )**4
1416 *
1417                   TEMP1 = ZERO
1418                   DO 220 J = 1, N
1419                      TEMP1 = MAX( TEMP1, ABS( D4( J )-WR( N-J+1 ) ) /
1420      $                       ( ABSTOL+ABS( D4( J ) ) ) )
1421   220             CONTINUE
1422 *
1423                   RESULT( 27 ) = TEMP1 / TEMP2
1424 *
1425                   IL = 1 + ( N-1 )*INT( SLARND( 1, ISEED2 ) )
1426                   IU = 1 + ( N-1 )*INT( SLARND( 1, ISEED2 ) )
1427                   IF( IU.LT.IL ) THEN
1428                      ITEMP = IU
1429                      IU = IL
1430                      IL = ITEMP
1431                   END IF
1432 *
1433                   IF( CRANGE ) THEN
1434                      NTEST = 28
1435                      ABSTOL = UNFL + UNFL
1436                      CALL CSTEMR( 'V', 'I', N, SD, SE, VL, VU, IL, IU,
1437      $                            M, WR, Z, LDU, N, IWORK( 1 ), TRYRAC,
1438      $                            RWORK, LRWORK, IWORK( 2*N+1 ),
1439      $                            LWORK-2*N, IINFO )
1440 *
1441                      IF( IINFO.NE.0 ) THEN
1442                         WRITE( NOUNIT, FMT = 9999 )'CSTEMR(V,I,rel)',
1443      $                     IINFO, N, JTYPE, IOLDSD
1444                         INFO = ABS( IINFO )
1445                         IF( IINFO.LT.0 ) THEN
1446                            RETURN
1447                         ELSE
1448                            RESULT( 28 ) = ULPINV
1449                            GO TO 270
1450                         END IF
1451                      END IF
1452 *
1453 *
1454 *                 Do test 28
1455 *
1456                      TEMP2 = TWO*( TWO*N-ONE )*ULP*
1457      $                       ( ONE+EIGHT*HALF**2 ) / ( ONE-HALF )**4
1458 *
1459                      TEMP1 = ZERO
1460                      DO 230 J = IL, IU
1461                         TEMP1 = MAX( TEMP1, ABS( WR( J-IL+1 )-D4( N-J+
1462      $                          1 ) ) / ( ABSTOL+ABS( WR( J-IL+1 ) ) ) )
1463   230                CONTINUE
1464 *
1465                      RESULT( 28 ) = TEMP1 / TEMP2
1466                   ELSE
1467                      RESULT( 28 ) = ZERO
1468                   END IF
1469                ELSE
1470                   RESULT( 27 ) = ZERO
1471                   RESULT( 28 ) = ZERO
1472                END IF
1473 *
1474 *           Call CSTEMR(V,I) to compute D1 and Z, do tests.
1475 *
1476 *           Compute D1 and Z
1477 *
1478                CALL SCOPY( N, SD, 1, D5, 1 )
1479                IF( N.GT.0 )
1480      $            CALL SCOPY( N-1, SE, 1, RWORK, 1 )
1481                CALL CLASET( 'Full', N, N, CZERO, CONE, Z, LDU )
1482 *
1483                IF( CRANGE ) THEN
1484                   NTEST = 29
1485                   IL = 1 + ( N-1 )*INT( SLARND( 1, ISEED2 ) )
1486                   IU = 1 + ( N-1 )*INT( SLARND( 1, ISEED2 ) )
1487                   IF( IU.LT.IL ) THEN
1488                      ITEMP = IU
1489                      IU = IL
1490                      IL = ITEMP
1491                   END IF
1492                   CALL CSTEMR( 'V', 'I', N, D5, RWORK, VL, VU, IL, IU,
1493      $                         M, D1, Z, LDU, N, IWORK( 1 ), TRYRAC,
1494      $                         RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ),
1495      $                         LIWORK-2*N, IINFO )
1496                   IF( IINFO.NE.0 ) THEN
1497                      WRITE( NOUNIT, FMT = 9999 )'CSTEMR(V,I)', IINFO,
1498      $                  N, JTYPE, IOLDSD
1499                      INFO = ABS( IINFO )
1500                      IF( IINFO.LT.0 ) THEN
1501                         RETURN
1502                      ELSE
1503                         RESULT( 29 ) = ULPINV
1504                         GO TO 280
1505                      END IF
1506                   END IF
1507 *
1508 *           Do Tests 29 and 30
1509 *
1510 *
1511 *           Call CSTEMR to compute D2, do tests.
1512 *
1513 *           Compute D2
1514 *
1515                   CALL SCOPY( N, SD, 1, D5, 1 )
1516                   IF( N.GT.0 )
1517      $               CALL SCOPY( N-1, SE, 1, RWORK, 1 )
1518 *
1519                   NTEST = 31
1520                   CALL CSTEMR( 'N', 'I', N, D5, RWORK, VL, VU, IL, IU,
1521      $                         M, D2, Z, LDU, N, IWORK( 1 ), TRYRAC,
1522      $                         RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ),
1523      $                         LIWORK-2*N, IINFO )
1524                   IF( IINFO.NE.0 ) THEN
1525                      WRITE( NOUNIT, FMT = 9999 )'CSTEMR(N,I)', IINFO,
1526      $                  N, JTYPE, IOLDSD
1527                      INFO = ABS( IINFO )
1528                      IF( IINFO.LT.0 ) THEN
1529                         RETURN
1530                      ELSE
1531                         RESULT( 31 ) = ULPINV
1532                         GO TO 280
1533                      END IF
1534                   END IF
1535 *
1536 *           Do Test 31
1537 *
1538                   TEMP1 = ZERO
1539                   TEMP2 = ZERO
1540 *
1541                   DO 240 J = 1, IU - IL + 1
1542                      TEMP1 = MAX( TEMP1, ABS( D1( J ) ),
1543      $                       ABS( D2( J ) ) )
1544                      TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
1545   240             CONTINUE
1546 *
1547                   RESULT( 31 ) = TEMP2 / MAX( UNFL,
1548      $                           ULP*MAX( TEMP1, TEMP2 ) )
1549 *
1550 *
1551 *           Call CSTEMR(V,V) to compute D1 and Z, do tests.
1552 *
1553 *           Compute D1 and Z
1554 *
1555                   CALL SCOPY( N, SD, 1, D5, 1 )
1556                   IF( N.GT.0 )
1557      $               CALL SCOPY( N-1, SE, 1, RWORK, 1 )
1558                   CALL CLASET( 'Full', N, N, CZERO, CONE, Z, LDU )
1559 *
1560                   NTEST = 32
1561 *
1562                   IF( N.GT.0 ) THEN
1563                      IF( IL.NE.1 ) THEN
1564                         VL = D2( IL ) - MAX( HALF*
1565      $                       ( D2( IL )-D2( IL-1 ) ), ULP*ANORM,
1566      $                       TWO*RTUNFL )
1567                      ELSE
1568                         VL = D2( 1 ) - MAX( HALF*( D2( N )-D2( 1 ) ),
1569      $                       ULP*ANORM, TWO*RTUNFL )
1570                      END IF
1571                      IF( IU.NE.N ) THEN
1572                         VU = D2( IU ) + MAX( HALF*
1573      $                       ( D2( IU+1 )-D2( IU ) ), ULP*ANORM,
1574      $                       TWO*RTUNFL )
1575                      ELSE
1576                         VU = D2( N ) + MAX( HALF*( D2( N )-D2( 1 ) ),
1577      $                       ULP*ANORM, TWO*RTUNFL )
1578                      END IF
1579                   ELSE
1580                      VL = ZERO
1581                      VU = ONE
1582                   END IF
1583 *
1584                   CALL CSTEMR( 'V', 'V', N, D5, RWORK, VL, VU, IL, IU,
1585      $                         M, D1, Z, LDU, N, IWORK( 1 ), TRYRAC,
1586      $                         RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ),
1587      $                         LIWORK-2*N, IINFO )
1588                   IF( IINFO.NE.0 ) THEN
1589                      WRITE( NOUNIT, FMT = 9999 )'CSTEMR(V,V)', IINFO,
1590      $                  N, JTYPE, IOLDSD
1591                      INFO = ABS( IINFO )
1592                      IF( IINFO.LT.0 ) THEN
1593                         RETURN
1594                      ELSE
1595                         RESULT( 32 ) = ULPINV
1596                         GO TO 280
1597                      END IF
1598                   END IF
1599 *
1600 *           Do Tests 32 and 33
1601 *
1602                   CALL CSTT22( N, M, 0, SD, SE, D1, DUMMA, Z, LDU, WORK,
1603      $                         M, RWORK, RESULT( 32 ) )
1604 *
1605 *           Call CSTEMR to compute D2, do tests.
1606 *
1607 *           Compute D2
1608 *
1609                   CALL SCOPY( N, SD, 1, D5, 1 )
1610                   IF( N.GT.0 )
1611      $               CALL SCOPY( N-1, SE, 1, RWORK, 1 )
1612 *
1613                   NTEST = 34
1614                   CALL CSTEMR( 'N', 'V', N, D5, RWORK, VL, VU, IL, IU,
1615      $                         M, D2, Z, LDU, N, IWORK( 1 ), TRYRAC,
1616      $                         RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ),
1617      $                         LIWORK-2*N, IINFO )
1618                   IF( IINFO.NE.0 ) THEN
1619                      WRITE( NOUNIT, FMT = 9999 )'CSTEMR(N,V)', IINFO,
1620      $                  N, JTYPE, IOLDSD
1621                      INFO = ABS( IINFO )
1622                      IF( IINFO.LT.0 ) THEN
1623                         RETURN
1624                      ELSE
1625                         RESULT( 34 ) = ULPINV
1626                         GO TO 280
1627                      END IF
1628                   END IF
1629 *
1630 *           Do Test 34
1631 *
1632                   TEMP1 = ZERO
1633                   TEMP2 = ZERO
1634 *
1635                   DO 250 J = 1, IU - IL + 1
1636                      TEMP1 = MAX( TEMP1, ABS( D1( J ) ),
1637      $                       ABS( D2( J ) ) )
1638                      TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
1639   250             CONTINUE
1640 *
1641                   RESULT( 34 ) = TEMP2 / MAX( UNFL,
1642      $                           ULP*MAX( TEMP1, TEMP2 ) )
1643                ELSE
1644                   RESULT( 29 ) = ZERO
1645                   RESULT( 30 ) = ZERO
1646                   RESULT( 31 ) = ZERO
1647                   RESULT( 32 ) = ZERO
1648                   RESULT( 33 ) = ZERO
1649                   RESULT( 34 ) = ZERO
1650                END IF
1651 *
1652 *
1653 *           Call CSTEMR(V,A) to compute D1 and Z, do tests.
1654 *
1655 *           Compute D1 and Z
1656 *
1657                CALL SCOPY( N, SD, 1, D5, 1 )
1658                IF( N.GT.0 )
1659      $            CALL SCOPY( N-1, SE, 1, RWORK, 1 )
1660 *
1661                NTEST = 35
1662 *
1663                CALL CSTEMR( 'V', 'A', N, D5, RWORK, VL, VU, IL, IU,
1664      $                      M, D1, Z, LDU, N, IWORK( 1 ), TRYRAC,
1665      $                      RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ),
1666      $                      LIWORK-2*N, IINFO )
1667                IF( IINFO.NE.0 ) THEN
1668                   WRITE( NOUNIT, FMT = 9999 )'CSTEMR(V,A)', IINFO, N,
1669      $               JTYPE, IOLDSD
1670                   INFO = ABS( IINFO )
1671                   IF( IINFO.LT.0 ) THEN
1672                      RETURN
1673                   ELSE
1674                      RESULT( 35 ) = ULPINV
1675                      GO TO 280
1676                   END IF
1677                END IF
1678 *
1679 *           Do Tests 35 and 36
1680 *
1681                CALL CSTT22( N, M, 0, SD, SE, D1, DUMMA, Z, LDU, WORK, M,
1682      $                      RWORK, RESULT( 35 ) )
1683 *
1684 *           Call CSTEMR to compute D2, do tests.
1685 *
1686 *           Compute D2
1687 *
1688                CALL SCOPY( N, SD, 1, D5, 1 )
1689                IF( N.GT.0 )
1690      $            CALL SCOPY( N-1, SE, 1, RWORK, 1 )
1691 *
1692                NTEST = 37
1693                CALL CSTEMR( 'N', 'A', N, D5, RWORK, VL, VU, IL, IU,
1694      $                      M, D2, Z, LDU, N, IWORK( 1 ), TRYRAC,
1695      $                      RWORK( N+1 ), LRWORK-N, IWORK( 2*N+1 ),
1696      $                      LIWORK-2*N, IINFO )
1697                IF( IINFO.NE.0 ) THEN
1698                   WRITE( NOUNIT, FMT = 9999 )'CSTEMR(N,A)', IINFO, N,
1699      $               JTYPE, IOLDSD
1700                   INFO = ABS( IINFO )
1701                   IF( IINFO.LT.0 ) THEN
1702                      RETURN
1703                   ELSE
1704                      RESULT( 37 ) = ULPINV
1705                      GO TO 280
1706                   END IF
1707                END IF
1708 *
1709 *           Do Test 34
1710 *
1711                TEMP1 = ZERO
1712                TEMP2 = ZERO
1713 *
1714                DO 260 J = 1, N
1715                   TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D2( J ) ) )
1716                   TEMP2 = MAX( TEMP2, ABS( D1( J )-D2( J ) ) )
1717   260          CONTINUE
1718 *
1719                RESULT( 37 ) = TEMP2 / MAX( UNFL,
1720      $                        ULP*MAX( TEMP1, TEMP2 ) )
1721             END IF
1722   270       CONTINUE
1723   280       CONTINUE
1724             NTESTT = NTESTT + NTEST
1725 *
1726 *           End of Loop -- Check for RESULT(j) > THRESH
1727 *
1728 *
1729 *           Print out tests which fail.
1730 *
1731             DO 290 JR = 1, NTEST
1732                IF( RESULT( JR ).GE.THRESH ) THEN
1733 *
1734 *                 If this is the first test to fail,
1735 *                 print a header to the data file.
1736 *
1737                   IF( NERRS.EQ.0 ) THEN
1738                      WRITE( NOUNIT, FMT = 9998 )'CST'
1739                      WRITE( NOUNIT, FMT = 9997 )
1740                      WRITE( NOUNIT, FMT = 9996 )
1741                      WRITE( NOUNIT, FMT = 9995 )'Hermitian'
1742                      WRITE( NOUNIT, FMT = 9994 )
1743 *
1744 *                    Tests performed
1745 *
1746                      WRITE( NOUNIT, FMT = 9987 )
1747                   END IF
1748                   NERRS = NERRS + 1
1749                   IF( RESULT( JR ).LT.10000.0E0 ) THEN
1750                      WRITE( NOUNIT, FMT = 9989 )N, JTYPE, IOLDSD, JR,
1751      $                  RESULT( JR )
1752                   ELSE
1753                      WRITE( NOUNIT, FMT = 9988 )N, JTYPE, IOLDSD, JR,
1754      $                  RESULT( JR )
1755                   END IF
1756                END IF
1757   290       CONTINUE
1758   300    CONTINUE
1759   310 CONTINUE
1760 *
1761 *     Summary
1762 *
1763       CALL SLASUM( 'CST', NOUNIT, NERRS, NTESTT )
1764       RETURN
1765 *
1766  9999 FORMAT( ' CCHKST: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
1767      $      I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
1768 *
1769  9998 FORMAT( / 1X, A3, ' -- Complex Hermitian eigenvalue problem' )
1770  9997 FORMAT( ' Matrix types (see CCHKST for details): ' )
1771 *
1772  9996 FORMAT( / ' Special Matrices:',
1773      $      / '  1=Zero matrix.                        ',
1774      $      '  5=Diagonal: clustered entries.',
1775      $      / '  2=Identity matrix.                    ',
1776      $      '  6=Diagonal: large, evenly spaced.',
1777      $      / '  3=Diagonal: evenly spaced entries.    ',
1778      $      '  7=Diagonal: small, evenly spaced.',
1779      $      / '  4=Diagonal: geometr. spaced entries.' )
1780  9995 FORMAT( ' Dense ', A, ' Matrices:',
1781      $      / '  8=Evenly spaced eigenvals.            ',
1782      $      ' 12=Small, evenly spaced eigenvals.',
1783      $      / '  9=Geometrically spaced eigenvals.     ',
1784      $      ' 13=Matrix with random O(1) entries.',
1785      $      / ' 10=Clustered eigenvalues.              ',
1786      $      ' 14=Matrix with large random entries.',
1787      $      / ' 11=Large, evenly spaced eigenvals.     ',
1788      $      ' 15=Matrix with small random entries.' )
1789  9994 FORMAT( ' 16=Positive definite, evenly spaced eigenvalues',
1790      $      / ' 17=Positive definite, geometrically spaced eigenvlaues',
1791      $      / ' 18=Positive definite, clustered eigenvalues',
1792      $      / ' 19=Positive definite, small evenly spaced eigenvalues',
1793      $      / ' 20=Positive definite, large evenly spaced eigenvalues',
1794      $      / ' 21=Diagonally dominant tridiagonal, geometrically',
1795      $      ' spaced eigenvalues' )
1796 *
1797  9993 FORMAT( / ' Tests performed:   ',
1798      $      '(S is Tridiag, D is diagonal, U and Z are ', A, ',', / 20X,
1799      $      A, ', W is a diagonal matrix of eigenvalues,', / 20X,
1800      $      ' V is U represented by Householder vectors, and', / 20X,
1801      $      ' Y is a matrix of eigenvectors of S.)',
1802      $      / ' CHETRD, UPLO=''U'':', / '  1= | A - V S V', A1,
1803      $      ' | / ( |A| n ulp )     ', '  2= | I - U V', A1,
1804      $      ' | / ( n ulp )', / ' CHETRD, UPLO=''L'':',
1805      $      / '  3= | A - V S V', A1, ' | / ( |A| n ulp )     ',
1806      $      '  4= | I - U V', A1, ' | / ( n ulp )' )
1807  9992 FORMAT( ' CHPTRD, UPLO=''U'':', / '  5= | A - V S V', A1,
1808      $      ' | / ( |A| n ulp )     ', '  6= | I - U V', A1,
1809      $      ' | / ( n ulp )', / ' CHPTRD, UPLO=''L'':',
1810      $      / '  7= | A - V S V', A1, ' | / ( |A| n ulp )     ',
1811      $      '  8= | I - U V', A1, ' | / ( n ulp )',
1812      $      / '  9= | S - Z D Z', A1, ' | / ( |S| n ulp )     ',
1813      $      ' 10= | I - Z Z', A1, ' | / ( n ulp )',
1814      $      / ' 11= |D(with Z) - D(w/o Z)| / (|D| ulp) ',
1815      $      ' 12= | D(PWK) - D(QR) | / (|D| ulp)',
1816      $      / ' 13=   Sturm sequence test on W         ' )
1817  9991 FORMAT( ' 14= | S - Z4 D4 Z4', A1, ' | / (|S| n ulp)',
1818      $      / ' 15= | I - Z4 Z4', A1, ' | / (n ulp ) ',
1819      $      ' 16= | D4 - D5 | / ( 100 |D4| ulp ) ',
1820      $      / ' 17= max | D4(i) - WR(i) | / ( |D4(i)| (2n-1) ulp )',
1821      $      / ' 18= | WA1 - D3 | / ( |D3| ulp )',
1822      $      / ' 19= max | WA2(i) - WA3(ii) | / ( |D3| ulp )',
1823      $      / ' 20= | S - Y WA1 Y', A1, ' | / ( |S| n ulp )',
1824      $      / ' 21= | I - Y Y', A1, ' | / ( n ulp )' )
1825  9990 FORMAT( ' 22= | S - Z D Z', A1,
1826      $      ' | / ( |S| n ulp ) for CSTEDC(I)', / ' 23= | I - Z Z', A1,
1827      $      ' | / ( n ulp )       for CSTEDC(I)', / ' 24= | S - Z D Z',
1828      $      A1, ' | / ( |S| n ulp ) for CSTEDC(V)', / ' 25= | I - Z Z',
1829      $      A1, ' | / ( n ulp )       for CSTEDC(V)',
1830      $      / ' 26= | D1(CSTEDC(V)) - D2(CSTEDC(N)) | / ( |D1| ulp )' )
1831  9989 FORMAT( ' Matrix order=', I5, ', type=', I2, ', seed=',
1832      $      4( I4, ',' ), ' result ', I3, ' is', 0P, F8.2 )
1833  9988 FORMAT( ' Matrix order=', I5, ', type=', I2, ', seed=',
1834      $      4( I4, ',' ), ' result ', I3, ' is', 1P, E10.3 )
1835 *
1836  9987 FORMAT( / 'Test performed:  see CCHKST for details.', / )
1837 *     End of CCHKST
1838 *
1839       END
Home