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