LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zchkhs.f
Go to the documentation of this file.
00001 *> \brief \b ZCHKHS
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 ZCHKHS( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
00012 *                          NOUNIT, A, LDA, H, T1, T2, U, LDU, Z, UZ, W1,
00013 *                          W3, EVECTL, EVECTR, EVECTY, EVECTX, UU, TAU,
00014 *                          WORK, NWORK, RWORK, IWORK, SELECT, RESULT,
00015 *                          INFO )
00016 * 
00017 *       .. Scalar Arguments ..
00018 *       INTEGER            INFO, LDA, LDU, NOUNIT, NSIZES, NTYPES, NWORK
00019 *       DOUBLE PRECISION   THRESH
00020 *       ..
00021 *       .. Array Arguments ..
00022 *       LOGICAL            DOTYPE( * ), SELECT( * )
00023 *       INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
00024 *       DOUBLE PRECISION   RESULT( 14 ), RWORK( * )
00025 *       COMPLEX*16         A( LDA, * ), EVECTL( LDU, * ),
00026 *      $                   EVECTR( LDU, * ), EVECTX( LDU, * ),
00027 *      $                   EVECTY( LDU, * ), H( LDA, * ), T1( LDA, * ),
00028 *      $                   T2( LDA, * ), TAU( * ), U( LDU, * ),
00029 *      $                   UU( LDU, * ), UZ( LDU, * ), W1( * ), W3( * ),
00030 *      $                   WORK( * ), Z( LDU, * )
00031 *       ..
00032 *  
00033 *
00034 *> \par Purpose:
00035 *  =============
00036 *>
00037 *> \verbatim
00038 *>
00039 *>    ZCHKHS  checks the nonsymmetric eigenvalue problem routines.
00040 *>
00041 *>            ZGEHRD factors A as  U H U' , where ' means conjugate
00042 *>            transpose, H is hessenberg, and U is unitary.
00043 *>
00044 *>            ZUNGHR generates the unitary matrix U.
00045 *>
00046 *>            ZUNMHR multiplies a matrix by the unitary matrix U.
00047 *>
00048 *>            ZHSEQR factors H as  Z T Z' , where Z is unitary and T
00049 *>            is upper triangular.  It also computes the eigenvalues,
00050 *>            w(1), ..., w(n); we define a diagonal matrix W whose
00051 *>            (diagonal) entries are the eigenvalues.
00052 *>
00053 *>            ZTREVC computes the left eigenvector matrix L and the
00054 *>            right eigenvector matrix R for the matrix T.  The
00055 *>            columns of L are the complex conjugates of the left
00056 *>            eigenvectors of T.  The columns of R are the right
00057 *>            eigenvectors of T.  L is lower triangular, and R is
00058 *>            upper triangular.
00059 *>
00060 *>            ZHSEIN computes the left eigenvector matrix Y and the
00061 *>            right eigenvector matrix X for the matrix H.  The
00062 *>            columns of Y are the complex conjugates of the left
00063 *>            eigenvectors of H.  The columns of X are the right
00064 *>            eigenvectors of H.  Y is lower triangular, and X is
00065 *>            upper triangular.
00066 *>
00067 *>    When ZCHKHS is called, a number of matrix "sizes" ("n's") and a
00068 *>    number of matrix "types" are specified.  For each size ("n")
00069 *>    and each type of matrix, one matrix will be generated and used
00070 *>    to test the nonsymmetric eigenroutines.  For each matrix, 14
00071 *>    tests will be performed:
00072 *>
00073 *>    (1)     | A - U H U**H | / ( |A| n ulp )
00074 *>
00075 *>    (2)     | I - UU**H | / ( n ulp )
00076 *>
00077 *>    (3)     | H - Z T Z**H | / ( |H| n ulp )
00078 *>
00079 *>    (4)     | I - ZZ**H | / ( n ulp )
00080 *>
00081 *>    (5)     | A - UZ H (UZ)**H | / ( |A| n ulp )
00082 *>
00083 *>    (6)     | I - UZ (UZ)**H | / ( n ulp )
00084 *>
00085 *>    (7)     | T(Z computed) - T(Z not computed) | / ( |T| ulp )
00086 *>
00087 *>    (8)     | W(Z computed) - W(Z not computed) | / ( |W| ulp )
00088 *>
00089 *>    (9)     | TR - RW | / ( |T| |R| ulp )
00090 *>
00091 *>    (10)    | L**H T - W**H L | / ( |T| |L| ulp )
00092 *>
00093 *>    (11)    | HX - XW | / ( |H| |X| ulp )
00094 *>
00095 *>    (12)    | Y**H H - W**H Y | / ( |H| |Y| ulp )
00096 *>
00097 *>    (13)    | AX - XW | / ( |A| |X| ulp )
00098 *>
00099 *>    (14)    | Y**H A - W**H Y | / ( |A| |Y| ulp )
00100 *>
00101 *>    The "sizes" are specified by an array NN(1:NSIZES); the value of
00102 *>    each element NN(j) specifies one size.
00103 *>    The "types" are specified by a logical array DOTYPE( 1:NTYPES );
00104 *>    if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
00105 *>    Currently, the list of possible types is:
00106 *>
00107 *>    (1)  The zero matrix.
00108 *>    (2)  The identity matrix.
00109 *>    (3)  A (transposed) Jordan block, with 1's on the diagonal.
00110 *>
00111 *>    (4)  A diagonal matrix with evenly spaced entries
00112 *>         1, ..., ULP  and random complex angles.
00113 *>         (ULP = (first number larger than 1) - 1 )
00114 *>    (5)  A diagonal matrix with geometrically spaced entries
00115 *>         1, ..., ULP  and random complex angles.
00116 *>    (6)  A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
00117 *>         and random complex angles.
00118 *>
00119 *>    (7)  Same as (4), but multiplied by SQRT( overflow threshold )
00120 *>    (8)  Same as (4), but multiplied by SQRT( underflow threshold )
00121 *>
00122 *>    (9)  A matrix of the form  U' T U, where U is unitary and
00123 *>         T has evenly spaced entries 1, ..., ULP with random complex
00124 *>         angles on the diagonal and random O(1) entries in the upper
00125 *>         triangle.
00126 *>
00127 *>    (10) A matrix of the form  U' T U, where U is unitary and
00128 *>         T has geometrically spaced entries 1, ..., ULP with random
00129 *>         complex angles on the diagonal and random O(1) entries in
00130 *>         the upper triangle.
00131 *>
00132 *>    (11) A matrix of the form  U' T U, where U is unitary and
00133 *>         T has "clustered" entries 1, ULP,..., ULP with random
00134 *>         complex angles on the diagonal and random O(1) entries in
00135 *>         the upper triangle.
00136 *>
00137 *>    (12) A matrix of the form  U' T U, where U is unitary and
00138 *>         T has complex eigenvalues randomly chosen from
00139 *>         ULP < |z| < 1   and random O(1) entries in the upper
00140 *>         triangle.
00141 *>
00142 *>    (13) A matrix of the form  X' T X, where X has condition
00143 *>         SQRT( ULP ) and T has evenly spaced entries 1, ..., ULP
00144 *>         with random complex angles on the diagonal and random O(1)
00145 *>         entries in the upper triangle.
00146 *>
00147 *>    (14) A matrix of the form  X' T X, where X has condition
00148 *>         SQRT( ULP ) and T has geometrically spaced entries
00149 *>         1, ..., ULP with random complex angles on the diagonal
00150 *>         and random O(1) entries in the upper triangle.
00151 *>
00152 *>    (15) A matrix of the form  X' T X, where X has condition
00153 *>         SQRT( ULP ) and T has "clustered" entries 1, ULP,..., ULP
00154 *>         with random complex angles on the diagonal and random O(1)
00155 *>         entries in the upper triangle.
00156 *>
00157 *>    (16) A matrix of the form  X' T X, where X has condition
00158 *>         SQRT( ULP ) and T has complex eigenvalues randomly chosen
00159 *>         from   ULP < |z| < 1   and random O(1) entries in the upper
00160 *>         triangle.
00161 *>
00162 *>    (17) Same as (16), but multiplied by SQRT( overflow threshold )
00163 *>    (18) Same as (16), but multiplied by SQRT( underflow threshold )
00164 *>
00165 *>    (19) Nonsymmetric matrix with random entries chosen from |z| < 1
00166 *>    (20) Same as (19), but multiplied by SQRT( overflow threshold )
00167 *>    (21) Same as (19), but multiplied by SQRT( underflow threshold )
00168 *> \endverbatim
00169 *
00170 *  Arguments:
00171 *  ==========
00172 *
00173 *> \verbatim
00174 *>  NSIZES - INTEGER
00175 *>           The number of sizes of matrices to use.  If it is zero,
00176 *>           ZCHKHS does nothing.  It must be at least zero.
00177 *>           Not modified.
00178 *>
00179 *>  NN     - INTEGER array, dimension (NSIZES)
00180 *>           An array containing the sizes to be used for the matrices.
00181 *>           Zero values will be skipped.  The values must be at least
00182 *>           zero.
00183 *>           Not modified.
00184 *>
00185 *>  NTYPES - INTEGER
00186 *>           The number of elements in DOTYPE.   If it is zero, ZCHKHS
00187 *>           does nothing.  It must be at least zero.  If it is MAXTYP+1
00188 *>           and NSIZES is 1, then an additional type, MAXTYP+1 is
00189 *>           defined, which is to use whatever matrix is in A.  This
00190 *>           is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
00191 *>           DOTYPE(MAXTYP+1) is .TRUE. .
00192 *>           Not modified.
00193 *>
00194 *>  DOTYPE - LOGICAL array, dimension (NTYPES)
00195 *>           If DOTYPE(j) is .TRUE., then for each size in NN a
00196 *>           matrix of that size and of type j will be generated.
00197 *>           If NTYPES is smaller than the maximum number of types
00198 *>           defined (PARAMETER MAXTYP), then types NTYPES+1 through
00199 *>           MAXTYP will not be generated.  If NTYPES is larger
00200 *>           than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
00201 *>           will be ignored.
00202 *>           Not modified.
00203 *>
00204 *>  ISEED  - INTEGER array, dimension (4)
00205 *>           On entry ISEED specifies the seed of the random number
00206 *>           generator. The array elements should be between 0 and 4095;
00207 *>           if not they will be reduced mod 4096.  Also, ISEED(4) must
00208 *>           be odd.  The random number generator uses a linear
00209 *>           congruential sequence limited to small integers, and so
00210 *>           should produce machine independent random numbers. The
00211 *>           values of ISEED are changed on exit, and can be used in the
00212 *>           next call to ZCHKHS to continue the same random number
00213 *>           sequence.
00214 *>           Modified.
00215 *>
00216 *>  THRESH - DOUBLE PRECISION
00217 *>           A test will count as "failed" if the "error", computed as
00218 *>           described above, exceeds THRESH.  Note that the error
00219 *>           is scaled to be O(1), so THRESH should be a reasonably
00220 *>           small multiple of 1, e.g., 10 or 100.  In particular,
00221 *>           it should not depend on the precision (single vs. double)
00222 *>           or the size of the matrix.  It must be at least zero.
00223 *>           Not modified.
00224 *>
00225 *>  NOUNIT - INTEGER
00226 *>           The FORTRAN unit number for printing out error messages
00227 *>           (e.g., if a routine returns IINFO not equal to 0.)
00228 *>           Not modified.
00229 *>
00230 *>  A      - COMPLEX*16 array, dimension (LDA,max(NN))
00231 *>           Used to hold the matrix whose eigenvalues are to be
00232 *>           computed.  On exit, A contains the last matrix actually
00233 *>           used.
00234 *>           Modified.
00235 *>
00236 *>  LDA    - INTEGER
00237 *>           The leading dimension of A, H, T1 and T2.  It must be at
00238 *>           least 1 and at least max( NN ).
00239 *>           Not modified.
00240 *>
00241 *>  H      - COMPLEX*16 array, dimension (LDA,max(NN))
00242 *>           The upper hessenberg matrix computed by ZGEHRD.  On exit,
00243 *>           H contains the Hessenberg form of the matrix in A.
00244 *>           Modified.
00245 *>
00246 *>  T1     - COMPLEX*16 array, dimension (LDA,max(NN))
00247 *>           The Schur (="quasi-triangular") matrix computed by ZHSEQR
00248 *>           if Z is computed.  On exit, T1 contains the Schur form of
00249 *>           the matrix in A.
00250 *>           Modified.
00251 *>
00252 *>  T2     - COMPLEX*16 array, dimension (LDA,max(NN))
00253 *>           The Schur matrix computed by ZHSEQR when Z is not computed.
00254 *>           This should be identical to T1.
00255 *>           Modified.
00256 *>
00257 *>  LDU    - INTEGER
00258 *>           The leading dimension of U, Z, UZ and UU.  It must be at
00259 *>           least 1 and at least max( NN ).
00260 *>           Not modified.
00261 *>
00262 *>  U      - COMPLEX*16 array, dimension (LDU,max(NN))
00263 *>           The unitary matrix computed by ZGEHRD.
00264 *>           Modified.
00265 *>
00266 *>  Z      - COMPLEX*16 array, dimension (LDU,max(NN))
00267 *>           The unitary matrix computed by ZHSEQR.
00268 *>           Modified.
00269 *>
00270 *>  UZ     - COMPLEX*16 array, dimension (LDU,max(NN))
00271 *>           The product of U times Z.
00272 *>           Modified.
00273 *>
00274 *>  W1     - COMPLEX*16 array, dimension (max(NN))
00275 *>           The eigenvalues of A, as computed by a full Schur
00276 *>           decomposition H = Z T Z'.  On exit, W1 contains the
00277 *>           eigenvalues of the matrix in A.
00278 *>           Modified.
00279 *>
00280 *>  W3     - COMPLEX*16 array, dimension (max(NN))
00281 *>           The eigenvalues of A, as computed by a partial Schur
00282 *>           decomposition (Z not computed, T only computed as much
00283 *>           as is necessary for determining eigenvalues).  On exit,
00284 *>           W3 contains the eigenvalues of the matrix in A, possibly
00285 *>           perturbed by ZHSEIN.
00286 *>           Modified.
00287 *>
00288 *>  EVECTL - COMPLEX*16 array, dimension (LDU,max(NN))
00289 *>           The conjugate transpose of the (upper triangular) left
00290 *>           eigenvector matrix for the matrix in T1.
00291 *>           Modified.
00292 *>
00293 *>  EVEZTR - COMPLEX*16 array, dimension (LDU,max(NN))
00294 *>           The (upper triangular) right eigenvector matrix for the
00295 *>           matrix in T1.
00296 *>           Modified.
00297 *>
00298 *>  EVECTY - COMPLEX*16 array, dimension (LDU,max(NN))
00299 *>           The conjugate transpose of the left eigenvector matrix
00300 *>           for the matrix in H.
00301 *>           Modified.
00302 *>
00303 *>  EVECTX - COMPLEX*16 array, dimension (LDU,max(NN))
00304 *>           The right eigenvector matrix for the matrix in H.
00305 *>           Modified.
00306 *>
00307 *>  UU     - COMPLEX*16 array, dimension (LDU,max(NN))
00308 *>           Details of the unitary matrix computed by ZGEHRD.
00309 *>           Modified.
00310 *>
00311 *>  TAU    - COMPLEX*16 array, dimension (max(NN))
00312 *>           Further details of the unitary matrix computed by ZGEHRD.
00313 *>           Modified.
00314 *>
00315 *>  WORK   - COMPLEX*16 array, dimension (NWORK)
00316 *>           Workspace.
00317 *>           Modified.
00318 *>
00319 *>  NWORK  - INTEGER
00320 *>           The number of entries in WORK.  NWORK >= 4*NN(j)*NN(j) + 2.
00321 *>
00322 *>  RWORK  - DOUBLE PRECISION array, dimension (max(NN))
00323 *>           Workspace.  Could be equivalenced to IWORK, but not SELECT.
00324 *>           Modified.
00325 *>
00326 *>  IWORK  - INTEGER array, dimension (max(NN))
00327 *>           Workspace.
00328 *>           Modified.
00329 *>
00330 *>  SELECT - LOGICAL array, dimension (max(NN))
00331 *>           Workspace.  Could be equivalenced to IWORK, but not RWORK.
00332 *>           Modified.
00333 *>
00334 *>  RESULT - DOUBLE PRECISION array, dimension (14)
00335 *>           The values computed by the fourteen tests described above.
00336 *>           The values are currently limited to 1/ulp, to avoid
00337 *>           overflow.
00338 *>           Modified.
00339 *>
00340 *>  INFO   - INTEGER
00341 *>           If 0, then everything ran OK.
00342 *>            -1: NSIZES < 0
00343 *>            -2: Some NN(j) < 0
00344 *>            -3: NTYPES < 0
00345 *>            -6: THRESH < 0
00346 *>            -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
00347 *>           -14: LDU < 1 or LDU < NMAX.
00348 *>           -26: NWORK too small.
00349 *>           If  ZLATMR, CLATMS, or CLATME returns an error code, the
00350 *>               absolute value of it is returned.
00351 *>           If 1, then ZHSEQR could not find all the shifts.
00352 *>           If 2, then the EISPACK code (for small blocks) failed.
00353 *>           If >2, then 30*N iterations were not enough to find an
00354 *>               eigenvalue or to decompose the problem.
00355 *>           Modified.
00356 *>
00357 *>-----------------------------------------------------------------------
00358 *>
00359 *>     Some Local Variables and Parameters:
00360 *>     ---- ----- --------- --- ----------
00361 *>
00362 *>     ZERO, ONE       Real 0 and 1.
00363 *>     MAXTYP          The number of types defined.
00364 *>     MTEST           The number of tests defined: care must be taken
00365 *>                     that (1) the size of RESULT, (2) the number of
00366 *>                     tests actually performed, and (3) MTEST agree.
00367 *>     NTEST           The number of tests performed on this matrix
00368 *>                     so far.  This should be less than MTEST, and
00369 *>                     equal to it by the last test.  It will be less
00370 *>                     if any of the routines being tested indicates
00371 *>                     that it could not compute the matrices that
00372 *>                     would be tested.
00373 *>     NMAX            Largest value in NN.
00374 *>     NMATS           The number of matrices generated so far.
00375 *>     NERRS           The number of tests which have exceeded THRESH
00376 *>                     so far (computed by DLAFTS).
00377 *>     COND, CONDS,
00378 *>     IMODE           Values to be passed to the matrix generators.
00379 *>     ANORM           Norm of A; passed to matrix generators.
00380 *>
00381 *>     OVFL, UNFL      Overflow and underflow thresholds.
00382 *>     ULP, ULPINV     Finest relative precision and its inverse.
00383 *>     RTOVFL, RTUNFL,
00384 *>     RTULP, RTULPI   Square roots of the previous 4 values.
00385 *>
00386 *>             The following four arrays decode JTYPE:
00387 *>     KTYPE(j)        The general type (1-10) for type "j".
00388 *>     KMODE(j)        The MODE value to be passed to the matrix
00389 *>                     generator for type "j".
00390 *>     KMAGN(j)        The order of magnitude ( O(1),
00391 *>                     O(overflow^(1/2) ), O(underflow^(1/2) )
00392 *>     KCONDS(j)       Selects whether CONDS is to be 1 or
00393 *>                     1/sqrt(ulp).  (0 means irrelevant.)
00394 *> \endverbatim
00395 *
00396 *  Authors:
00397 *  ========
00398 *
00399 *> \author Univ. of Tennessee 
00400 *> \author Univ. of California Berkeley 
00401 *> \author Univ. of Colorado Denver 
00402 *> \author NAG Ltd. 
00403 *
00404 *> \date November 2011
00405 *
00406 *> \ingroup complex16_eig
00407 *
00408 *  =====================================================================
00409       SUBROUTINE ZCHKHS( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
00410      $                   NOUNIT, A, LDA, H, T1, T2, U, LDU, Z, UZ, W1,
00411      $                   W3, EVECTL, EVECTR, EVECTY, EVECTX, UU, TAU,
00412      $                   WORK, NWORK, RWORK, IWORK, SELECT, RESULT,
00413      $                   INFO )
00414 *
00415 *  -- LAPACK test routine (version 3.4.0) --
00416 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00417 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00418 *     November 2011
00419 *
00420 *     .. Scalar Arguments ..
00421       INTEGER            INFO, LDA, LDU, NOUNIT, NSIZES, NTYPES, NWORK
00422       DOUBLE PRECISION   THRESH
00423 *     ..
00424 *     .. Array Arguments ..
00425       LOGICAL            DOTYPE( * ), SELECT( * )
00426       INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
00427       DOUBLE PRECISION   RESULT( 14 ), RWORK( * )
00428       COMPLEX*16         A( LDA, * ), EVECTL( LDU, * ),
00429      $                   EVECTR( LDU, * ), EVECTX( LDU, * ),
00430      $                   EVECTY( LDU, * ), H( LDA, * ), T1( LDA, * ),
00431      $                   T2( LDA, * ), TAU( * ), U( LDU, * ),
00432      $                   UU( LDU, * ), UZ( LDU, * ), W1( * ), W3( * ),
00433      $                   WORK( * ), Z( LDU, * )
00434 *     ..
00435 *
00436 *  =====================================================================
00437 *
00438 *     .. Parameters ..
00439       DOUBLE PRECISION   ZERO, ONE
00440       PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
00441       COMPLEX*16         CZERO, CONE
00442       PARAMETER          ( CZERO = ( 0.0D+0, 0.0D+0 ),
00443      $                   CONE = ( 1.0D+0, 0.0D+0 ) )
00444       INTEGER            MAXTYP
00445       PARAMETER          ( MAXTYP = 21 )
00446 *     ..
00447 *     .. Local Scalars ..
00448       LOGICAL            BADNN, MATCH
00449       INTEGER            I, IHI, IINFO, ILO, IMODE, IN, ITYPE, J, JCOL,
00450      $                   JJ, JSIZE, JTYPE, K, MTYPES, N, N1, NERRS,
00451      $                   NMATS, NMAX, NTEST, NTESTT
00452       DOUBLE PRECISION   ANINV, ANORM, COND, CONDS, OVFL, RTOVFL, RTULP,
00453      $                   RTULPI, RTUNFL, TEMP1, TEMP2, ULP, ULPINV, UNFL
00454 *     ..
00455 *     .. Local Arrays ..
00456       INTEGER            IDUMMA( 1 ), IOLDSD( 4 ), KCONDS( MAXTYP ),
00457      $                   KMAGN( MAXTYP ), KMODE( MAXTYP ),
00458      $                   KTYPE( MAXTYP )
00459       DOUBLE PRECISION   DUMMA( 4 )
00460       COMPLEX*16         CDUMMA( 4 )
00461 *     ..
00462 *     .. External Functions ..
00463       DOUBLE PRECISION   DLAMCH
00464       EXTERNAL           DLAMCH
00465 *     ..
00466 *     .. External Subroutines ..
00467       EXTERNAL           DLABAD, DLAFTS, DLASUM, XERBLA, ZCOPY, ZGEHRD,
00468      $                   ZGEMM, ZGET10, ZGET22, ZHSEIN, ZHSEQR, ZHST01,
00469      $                   ZLACPY, ZLASET, ZLATME, ZLATMR, ZLATMS, ZTREVC,
00470      $                   ZUNGHR, ZUNMHR
00471 *     ..
00472 *     .. Intrinsic Functions ..
00473       INTRINSIC          ABS, DBLE, MAX, MIN, SQRT
00474 *     ..
00475 *     .. Data statements ..
00476       DATA               KTYPE / 1, 2, 3, 5*4, 4*6, 6*6, 3*9 /
00477       DATA               KMAGN / 3*1, 1, 1, 1, 2, 3, 4*1, 1, 1, 1, 1, 2,
00478      $                   3, 1, 2, 3 /
00479       DATA               KMODE / 3*0, 4, 3, 1, 4, 4, 4, 3, 1, 5, 4, 3,
00480      $                   1, 5, 5, 5, 4, 3, 1 /
00481       DATA               KCONDS / 3*0, 5*0, 4*1, 6*2, 3*0 /
00482 *     ..
00483 *     .. Executable Statements ..
00484 *
00485 *     Check for errors
00486 *
00487       NTESTT = 0
00488       INFO = 0
00489 *
00490       BADNN = .FALSE.
00491       NMAX = 0
00492       DO 10 J = 1, NSIZES
00493          NMAX = MAX( NMAX, NN( J ) )
00494          IF( NN( J ).LT.0 )
00495      $      BADNN = .TRUE.
00496    10 CONTINUE
00497 *
00498 *     Check for errors
00499 *
00500       IF( NSIZES.LT.0 ) THEN
00501          INFO = -1
00502       ELSE IF( BADNN ) THEN
00503          INFO = -2
00504       ELSE IF( NTYPES.LT.0 ) THEN
00505          INFO = -3
00506       ELSE IF( THRESH.LT.ZERO ) THEN
00507          INFO = -6
00508       ELSE IF( LDA.LE.1 .OR. LDA.LT.NMAX ) THEN
00509          INFO = -9
00510       ELSE IF( LDU.LE.1 .OR. LDU.LT.NMAX ) THEN
00511          INFO = -14
00512       ELSE IF( 4*NMAX*NMAX+2.GT.NWORK ) THEN
00513          INFO = -26
00514       END IF
00515 *
00516       IF( INFO.NE.0 ) THEN
00517          CALL XERBLA( 'ZCHKHS', -INFO )
00518          RETURN
00519       END IF
00520 *
00521 *     Quick return if possible
00522 *
00523       IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 )
00524      $   RETURN
00525 *
00526 *     More important constants
00527 *
00528       UNFL = DLAMCH( 'Safe minimum' )
00529       OVFL = DLAMCH( 'Overflow' )
00530       CALL DLABAD( UNFL, OVFL )
00531       ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' )
00532       ULPINV = ONE / ULP
00533       RTUNFL = SQRT( UNFL )
00534       RTOVFL = SQRT( OVFL )
00535       RTULP = SQRT( ULP )
00536       RTULPI = ONE / RTULP
00537 *
00538 *     Loop over sizes, types
00539 *
00540       NERRS = 0
00541       NMATS = 0
00542 *
00543       DO 260 JSIZE = 1, NSIZES
00544          N = NN( JSIZE )
00545          IF( N.EQ.0 )
00546      $      GO TO 260
00547          N1 = MAX( 1, N )
00548          ANINV = ONE / DBLE( N1 )
00549 *
00550          IF( NSIZES.NE.1 ) THEN
00551             MTYPES = MIN( MAXTYP, NTYPES )
00552          ELSE
00553             MTYPES = MIN( MAXTYP+1, NTYPES )
00554          END IF
00555 *
00556          DO 250 JTYPE = 1, MTYPES
00557             IF( .NOT.DOTYPE( JTYPE ) )
00558      $         GO TO 250
00559             NMATS = NMATS + 1
00560             NTEST = 0
00561 *
00562 *           Save ISEED in case of an error.
00563 *
00564             DO 20 J = 1, 4
00565                IOLDSD( J ) = ISEED( J )
00566    20       CONTINUE
00567 *
00568 *           Initialize RESULT
00569 *
00570             DO 30 J = 1, 14
00571                RESULT( J ) = ZERO
00572    30       CONTINUE
00573 *
00574 *           Compute "A"
00575 *
00576 *           Control parameters:
00577 *
00578 *           KMAGN  KCONDS  KMODE        KTYPE
00579 *       =1  O(1)   1       clustered 1  zero
00580 *       =2  large  large   clustered 2  identity
00581 *       =3  small          exponential  Jordan
00582 *       =4                 arithmetic   diagonal, (w/ eigenvalues)
00583 *       =5                 random log   hermitian, w/ eigenvalues
00584 *       =6                 random       general, w/ eigenvalues
00585 *       =7                              random diagonal
00586 *       =8                              random hermitian
00587 *       =9                              random general
00588 *       =10                             random triangular
00589 *
00590             IF( MTYPES.GT.MAXTYP )
00591      $         GO TO 100
00592 *
00593             ITYPE = KTYPE( JTYPE )
00594             IMODE = KMODE( JTYPE )
00595 *
00596 *           Compute norm
00597 *
00598             GO TO ( 40, 50, 60 )KMAGN( JTYPE )
00599 *
00600    40       CONTINUE
00601             ANORM = ONE
00602             GO TO 70
00603 *
00604    50       CONTINUE
00605             ANORM = ( RTOVFL*ULP )*ANINV
00606             GO TO 70
00607 *
00608    60       CONTINUE
00609             ANORM = RTUNFL*N*ULPINV
00610             GO TO 70
00611 *
00612    70       CONTINUE
00613 *
00614             CALL ZLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
00615             IINFO = 0
00616             COND = ULPINV
00617 *
00618 *           Special Matrices
00619 *
00620             IF( ITYPE.EQ.1 ) THEN
00621 *
00622 *              Zero
00623 *
00624                IINFO = 0
00625             ELSE IF( ITYPE.EQ.2 ) THEN
00626 *
00627 *              Identity
00628 *
00629                DO 80 JCOL = 1, N
00630                   A( JCOL, JCOL ) = ANORM
00631    80          CONTINUE
00632 *
00633             ELSE IF( ITYPE.EQ.3 ) THEN
00634 *
00635 *              Jordan Block
00636 *
00637                DO 90 JCOL = 1, N
00638                   A( JCOL, JCOL ) = ANORM
00639                   IF( JCOL.GT.1 )
00640      $               A( JCOL, JCOL-1 ) = ONE
00641    90          CONTINUE
00642 *
00643             ELSE IF( ITYPE.EQ.4 ) THEN
00644 *
00645 *              Diagonal Matrix, [Eigen]values Specified
00646 *
00647                CALL ZLATMR( N, N, 'D', ISEED, 'N', WORK, IMODE, COND,
00648      $                      CONE, 'T', 'N', WORK( N+1 ), 1, ONE,
00649      $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
00650      $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
00651 *
00652             ELSE IF( ITYPE.EQ.5 ) THEN
00653 *
00654 *              Hermitian, eigenvalues specified
00655 *
00656                CALL ZLATMS( N, N, 'D', ISEED, 'H', RWORK, IMODE, COND,
00657      $                      ANORM, N, N, 'N', A, LDA, WORK, IINFO )
00658 *
00659             ELSE IF( ITYPE.EQ.6 ) THEN
00660 *
00661 *              General, eigenvalues specified
00662 *
00663                IF( KCONDS( JTYPE ).EQ.1 ) THEN
00664                   CONDS = ONE
00665                ELSE IF( KCONDS( JTYPE ).EQ.2 ) THEN
00666                   CONDS = RTULPI
00667                ELSE
00668                   CONDS = ZERO
00669                END IF
00670 *
00671                CALL ZLATME( N, 'D', ISEED, WORK, IMODE, COND, CONE,
00672      $                      'T', 'T', 'T', RWORK, 4, CONDS, N, N, ANORM,
00673      $                      A, LDA, WORK( N+1 ), IINFO )
00674 *
00675             ELSE IF( ITYPE.EQ.7 ) THEN
00676 *
00677 *              Diagonal, random eigenvalues
00678 *
00679                CALL ZLATMR( N, N, 'D', ISEED, 'N', WORK, 6, ONE, CONE,
00680      $                      'T', 'N', WORK( N+1 ), 1, ONE,
00681      $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
00682      $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
00683 *
00684             ELSE IF( ITYPE.EQ.8 ) THEN
00685 *
00686 *              Hermitian, random eigenvalues
00687 *
00688                CALL ZLATMR( N, N, 'D', ISEED, 'H', WORK, 6, ONE, CONE,
00689      $                      'T', 'N', WORK( N+1 ), 1, ONE,
00690      $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N,
00691      $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
00692 *
00693             ELSE IF( ITYPE.EQ.9 ) THEN
00694 *
00695 *              General, random eigenvalues
00696 *
00697                CALL ZLATMR( N, N, 'D', ISEED, 'N', WORK, 6, ONE, CONE,
00698      $                      'T', 'N', WORK( N+1 ), 1, ONE,
00699      $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N,
00700      $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
00701 *
00702             ELSE IF( ITYPE.EQ.10 ) THEN
00703 *
00704 *              Triangular, random eigenvalues
00705 *
00706                CALL ZLATMR( N, N, 'D', ISEED, 'N', WORK, 6, ONE, CONE,
00707      $                      'T', 'N', WORK( N+1 ), 1, ONE,
00708      $                      WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, 0,
00709      $                      ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
00710 *
00711             ELSE
00712 *
00713                IINFO = 1
00714             END IF
00715 *
00716             IF( IINFO.NE.0 ) THEN
00717                WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE,
00718      $            IOLDSD
00719                INFO = ABS( IINFO )
00720                RETURN
00721             END IF
00722 *
00723   100       CONTINUE
00724 *
00725 *           Call ZGEHRD to compute H and U, do tests.
00726 *
00727             CALL ZLACPY( ' ', N, N, A, LDA, H, LDA )
00728             NTEST = 1
00729 *
00730             ILO = 1
00731             IHI = N
00732 *
00733             CALL ZGEHRD( N, ILO, IHI, H, LDA, WORK, WORK( N+1 ),
00734      $                   NWORK-N, IINFO )
00735 *
00736             IF( IINFO.NE.0 ) THEN
00737                RESULT( 1 ) = ULPINV
00738                WRITE( NOUNIT, FMT = 9999 )'ZGEHRD', IINFO, N, JTYPE,
00739      $            IOLDSD
00740                INFO = ABS( IINFO )
00741                GO TO 240
00742             END IF
00743 *
00744             DO 120 J = 1, N - 1
00745                UU( J+1, J ) = CZERO
00746                DO 110 I = J + 2, N
00747                   U( I, J ) = H( I, J )
00748                   UU( I, J ) = H( I, J )
00749                   H( I, J ) = CZERO
00750   110          CONTINUE
00751   120       CONTINUE
00752             CALL ZCOPY( N-1, WORK, 1, TAU, 1 )
00753             CALL ZUNGHR( N, ILO, IHI, U, LDU, WORK, WORK( N+1 ),
00754      $                   NWORK-N, IINFO )
00755             NTEST = 2
00756 *
00757             CALL ZHST01( N, ILO, IHI, A, LDA, H, LDA, U, LDU, WORK,
00758      $                   NWORK, RWORK, RESULT( 1 ) )
00759 *
00760 *           Call ZHSEQR to compute T1, T2 and Z, do tests.
00761 *
00762 *           Eigenvalues only (W3)
00763 *
00764             CALL ZLACPY( ' ', N, N, H, LDA, T2, LDA )
00765             NTEST = 3
00766             RESULT( 3 ) = ULPINV
00767 *
00768             CALL ZHSEQR( 'E', 'N', N, ILO, IHI, T2, LDA, W3, UZ, LDU,
00769      $                   WORK, NWORK, IINFO )
00770             IF( IINFO.NE.0 ) THEN
00771                WRITE( NOUNIT, FMT = 9999 )'ZHSEQR(E)', IINFO, N, JTYPE,
00772      $            IOLDSD
00773                IF( IINFO.LE.N+2 ) THEN
00774                   INFO = ABS( IINFO )
00775                   GO TO 240
00776                END IF
00777             END IF
00778 *
00779 *           Eigenvalues (W1) and Full Schur Form (T2)
00780 *
00781             CALL ZLACPY( ' ', N, N, H, LDA, T2, LDA )
00782 *
00783             CALL ZHSEQR( 'S', 'N', N, ILO, IHI, T2, LDA, W1, UZ, LDU,
00784      $                   WORK, NWORK, IINFO )
00785             IF( IINFO.NE.0 .AND. IINFO.LE.N+2 ) THEN
00786                WRITE( NOUNIT, FMT = 9999 )'ZHSEQR(S)', IINFO, N, JTYPE,
00787      $            IOLDSD
00788                INFO = ABS( IINFO )
00789                GO TO 240
00790             END IF
00791 *
00792 *           Eigenvalues (W1), Schur Form (T1), and Schur Vectors (UZ)
00793 *
00794             CALL ZLACPY( ' ', N, N, H, LDA, T1, LDA )
00795             CALL ZLACPY( ' ', N, N, U, LDU, UZ, LDU )
00796 *
00797             CALL ZHSEQR( 'S', 'V', N, ILO, IHI, T1, LDA, W1, UZ, LDU,
00798      $                   WORK, NWORK, IINFO )
00799             IF( IINFO.NE.0 .AND. IINFO.LE.N+2 ) THEN
00800                WRITE( NOUNIT, FMT = 9999 )'ZHSEQR(V)', IINFO, N, JTYPE,
00801      $            IOLDSD
00802                INFO = ABS( IINFO )
00803                GO TO 240
00804             END IF
00805 *
00806 *           Compute Z = U' UZ
00807 *
00808             CALL ZGEMM( 'C', 'N', N, N, N, CONE, U, LDU, UZ, LDU, CZERO,
00809      $                  Z, LDU )
00810             NTEST = 8
00811 *
00812 *           Do Tests 3: | H - Z T Z' | / ( |H| n ulp )
00813 *                and 4: | I - Z Z' | / ( n ulp )
00814 *
00815             CALL ZHST01( N, ILO, IHI, H, LDA, T1, LDA, Z, LDU, WORK,
00816      $                   NWORK, RWORK, RESULT( 3 ) )
00817 *
00818 *           Do Tests 5: | A - UZ T (UZ)' | / ( |A| n ulp )
00819 *                and 6: | I - UZ (UZ)' | / ( n ulp )
00820 *
00821             CALL ZHST01( N, ILO, IHI, A, LDA, T1, LDA, UZ, LDU, WORK,
00822      $                   NWORK, RWORK, RESULT( 5 ) )
00823 *
00824 *           Do Test 7: | T2 - T1 | / ( |T| n ulp )
00825 *
00826             CALL ZGET10( N, N, T2, LDA, T1, LDA, WORK, RWORK,
00827      $                   RESULT( 7 ) )
00828 *
00829 *           Do Test 8: | W3 - W1 | / ( max(|W1|,|W3|) ulp )
00830 *
00831             TEMP1 = ZERO
00832             TEMP2 = ZERO
00833             DO 130 J = 1, N
00834                TEMP1 = MAX( TEMP1, ABS( W1( J ) ), ABS( W3( J ) ) )
00835                TEMP2 = MAX( TEMP2, ABS( W1( J )-W3( J ) ) )
00836   130       CONTINUE
00837 *
00838             RESULT( 8 ) = TEMP2 / MAX( UNFL, ULP*MAX( TEMP1, TEMP2 ) )
00839 *
00840 *           Compute the Left and Right Eigenvectors of T
00841 *
00842 *           Compute the Right eigenvector Matrix:
00843 *
00844             NTEST = 9
00845             RESULT( 9 ) = ULPINV
00846 *
00847 *           Select every other eigenvector
00848 *
00849             DO 140 J = 1, N
00850                SELECT( J ) = .FALSE.
00851   140       CONTINUE
00852             DO 150 J = 1, N, 2
00853                SELECT( J ) = .TRUE.
00854   150       CONTINUE
00855             CALL ZTREVC( 'Right', 'All', SELECT, N, T1, LDA, CDUMMA,
00856      $                   LDU, EVECTR, LDU, N, IN, WORK, RWORK, IINFO )
00857             IF( IINFO.NE.0 ) THEN
00858                WRITE( NOUNIT, FMT = 9999 )'ZTREVC(R,A)', IINFO, N,
00859      $            JTYPE, IOLDSD
00860                INFO = ABS( IINFO )
00861                GO TO 240
00862             END IF
00863 *
00864 *           Test 9:  | TR - RW | / ( |T| |R| ulp )
00865 *
00866             CALL ZGET22( 'N', 'N', 'N', N, T1, LDA, EVECTR, LDU, W1,
00867      $                   WORK, RWORK, DUMMA( 1 ) )
00868             RESULT( 9 ) = DUMMA( 1 )
00869             IF( DUMMA( 2 ).GT.THRESH ) THEN
00870                WRITE( NOUNIT, FMT = 9998 )'Right', 'ZTREVC',
00871      $            DUMMA( 2 ), N, JTYPE, IOLDSD
00872             END IF
00873 *
00874 *           Compute selected right eigenvectors and confirm that
00875 *           they agree with previous right eigenvectors
00876 *
00877             CALL ZTREVC( 'Right', 'Some', SELECT, N, T1, LDA, CDUMMA,
00878      $                   LDU, EVECTL, LDU, N, IN, WORK, RWORK, IINFO )
00879             IF( IINFO.NE.0 ) THEN
00880                WRITE( NOUNIT, FMT = 9999 )'ZTREVC(R,S)', IINFO, N,
00881      $            JTYPE, IOLDSD
00882                INFO = ABS( IINFO )
00883                GO TO 240
00884             END IF
00885 *
00886             K = 1
00887             MATCH = .TRUE.
00888             DO 170 J = 1, N
00889                IF( SELECT( J ) ) THEN
00890                   DO 160 JJ = 1, N
00891                      IF( EVECTR( JJ, J ).NE.EVECTL( JJ, K ) ) THEN
00892                         MATCH = .FALSE.
00893                         GO TO 180
00894                      END IF
00895   160             CONTINUE
00896                   K = K + 1
00897                END IF
00898   170       CONTINUE
00899   180       CONTINUE
00900             IF( .NOT.MATCH )
00901      $         WRITE( NOUNIT, FMT = 9997 )'Right', 'ZTREVC', N, JTYPE,
00902      $         IOLDSD
00903 *
00904 *           Compute the Left eigenvector Matrix:
00905 *
00906             NTEST = 10
00907             RESULT( 10 ) = ULPINV
00908             CALL ZTREVC( 'Left', 'All', SELECT, N, T1, LDA, EVECTL, LDU,
00909      $                   CDUMMA, LDU, N, IN, WORK, RWORK, IINFO )
00910             IF( IINFO.NE.0 ) THEN
00911                WRITE( NOUNIT, FMT = 9999 )'ZTREVC(L,A)', IINFO, N,
00912      $            JTYPE, IOLDSD
00913                INFO = ABS( IINFO )
00914                GO TO 240
00915             END IF
00916 *
00917 *           Test 10:  | LT - WL | / ( |T| |L| ulp )
00918 *
00919             CALL ZGET22( 'C', 'N', 'C', N, T1, LDA, EVECTL, LDU, W1,
00920      $                   WORK, RWORK, DUMMA( 3 ) )
00921             RESULT( 10 ) = DUMMA( 3 )
00922             IF( DUMMA( 4 ).GT.THRESH ) THEN
00923                WRITE( NOUNIT, FMT = 9998 )'Left', 'ZTREVC', DUMMA( 4 ),
00924      $            N, JTYPE, IOLDSD
00925             END IF
00926 *
00927 *           Compute selected left eigenvectors and confirm that
00928 *           they agree with previous left eigenvectors
00929 *
00930             CALL ZTREVC( 'Left', 'Some', SELECT, N, T1, LDA, EVECTR,
00931      $                   LDU, CDUMMA, LDU, N, IN, WORK, RWORK, IINFO )
00932             IF( IINFO.NE.0 ) THEN
00933                WRITE( NOUNIT, FMT = 9999 )'ZTREVC(L,S)', IINFO, N,
00934      $            JTYPE, IOLDSD
00935                INFO = ABS( IINFO )
00936                GO TO 240
00937             END IF
00938 *
00939             K = 1
00940             MATCH = .TRUE.
00941             DO 200 J = 1, N
00942                IF( SELECT( J ) ) THEN
00943                   DO 190 JJ = 1, N
00944                      IF( EVECTL( JJ, J ).NE.EVECTR( JJ, K ) ) THEN
00945                         MATCH = .FALSE.
00946                         GO TO 210
00947                      END IF
00948   190             CONTINUE
00949                   K = K + 1
00950                END IF
00951   200       CONTINUE
00952   210       CONTINUE
00953             IF( .NOT.MATCH )
00954      $         WRITE( NOUNIT, FMT = 9997 )'Left', 'ZTREVC', N, JTYPE,
00955      $         IOLDSD
00956 *
00957 *           Call ZHSEIN for Right eigenvectors of H, do test 11
00958 *
00959             NTEST = 11
00960             RESULT( 11 ) = ULPINV
00961             DO 220 J = 1, N
00962                SELECT( J ) = .TRUE.
00963   220       CONTINUE
00964 *
00965             CALL ZHSEIN( 'Right', 'Qr', 'Ninitv', SELECT, N, H, LDA, W3,
00966      $                   CDUMMA, LDU, EVECTX, LDU, N1, IN, WORK, RWORK,
00967      $                   IWORK, IWORK, IINFO )
00968             IF( IINFO.NE.0 ) THEN
00969                WRITE( NOUNIT, FMT = 9999 )'ZHSEIN(R)', IINFO, N, JTYPE,
00970      $            IOLDSD
00971                INFO = ABS( IINFO )
00972                IF( IINFO.LT.0 )
00973      $            GO TO 240
00974             ELSE
00975 *
00976 *              Test 11:  | HX - XW | / ( |H| |X| ulp )
00977 *
00978 *                        (from inverse iteration)
00979 *
00980                CALL ZGET22( 'N', 'N', 'N', N, H, LDA, EVECTX, LDU, W3,
00981      $                      WORK, RWORK, DUMMA( 1 ) )
00982                IF( DUMMA( 1 ).LT.ULPINV )
00983      $            RESULT( 11 ) = DUMMA( 1 )*ANINV
00984                IF( DUMMA( 2 ).GT.THRESH ) THEN
00985                   WRITE( NOUNIT, FMT = 9998 )'Right', 'ZHSEIN',
00986      $               DUMMA( 2 ), N, JTYPE, IOLDSD
00987                END IF
00988             END IF
00989 *
00990 *           Call ZHSEIN for Left eigenvectors of H, do test 12
00991 *
00992             NTEST = 12
00993             RESULT( 12 ) = ULPINV
00994             DO 230 J = 1, N
00995                SELECT( J ) = .TRUE.
00996   230       CONTINUE
00997 *
00998             CALL ZHSEIN( 'Left', 'Qr', 'Ninitv', SELECT, N, H, LDA, W3,
00999      $                   EVECTY, LDU, CDUMMA, LDU, N1, IN, WORK, RWORK,
01000      $                   IWORK, IWORK, IINFO )
01001             IF( IINFO.NE.0 ) THEN
01002                WRITE( NOUNIT, FMT = 9999 )'ZHSEIN(L)', IINFO, N, JTYPE,
01003      $            IOLDSD
01004                INFO = ABS( IINFO )
01005                IF( IINFO.LT.0 )
01006      $            GO TO 240
01007             ELSE
01008 *
01009 *              Test 12:  | YH - WY | / ( |H| |Y| ulp )
01010 *
01011 *                        (from inverse iteration)
01012 *
01013                CALL ZGET22( 'C', 'N', 'C', N, H, LDA, EVECTY, LDU, W3,
01014      $                      WORK, RWORK, DUMMA( 3 ) )
01015                IF( DUMMA( 3 ).LT.ULPINV )
01016      $            RESULT( 12 ) = DUMMA( 3 )*ANINV
01017                IF( DUMMA( 4 ).GT.THRESH ) THEN
01018                   WRITE( NOUNIT, FMT = 9998 )'Left', 'ZHSEIN',
01019      $               DUMMA( 4 ), N, JTYPE, IOLDSD
01020                END IF
01021             END IF
01022 *
01023 *           Call ZUNMHR for Right eigenvectors of A, do test 13
01024 *
01025             NTEST = 13
01026             RESULT( 13 ) = ULPINV
01027 *
01028             CALL ZUNMHR( 'Left', 'No transpose', N, N, ILO, IHI, UU,
01029      $                   LDU, TAU, EVECTX, LDU, WORK, NWORK, IINFO )
01030             IF( IINFO.NE.0 ) THEN
01031                WRITE( NOUNIT, FMT = 9999 )'ZUNMHR(L)', IINFO, N, JTYPE,
01032      $            IOLDSD
01033                INFO = ABS( IINFO )
01034                IF( IINFO.LT.0 )
01035      $            GO TO 240
01036             ELSE
01037 *
01038 *              Test 13:  | AX - XW | / ( |A| |X| ulp )
01039 *
01040 *                        (from inverse iteration)
01041 *
01042                CALL ZGET22( 'N', 'N', 'N', N, A, LDA, EVECTX, LDU, W3,
01043      $                      WORK, RWORK, DUMMA( 1 ) )
01044                IF( DUMMA( 1 ).LT.ULPINV )
01045      $            RESULT( 13 ) = DUMMA( 1 )*ANINV
01046             END IF
01047 *
01048 *           Call ZUNMHR for Left eigenvectors of A, do test 14
01049 *
01050             NTEST = 14
01051             RESULT( 14 ) = ULPINV
01052 *
01053             CALL ZUNMHR( 'Left', 'No transpose', N, N, ILO, IHI, UU,
01054      $                   LDU, TAU, EVECTY, LDU, WORK, NWORK, IINFO )
01055             IF( IINFO.NE.0 ) THEN
01056                WRITE( NOUNIT, FMT = 9999 )'ZUNMHR(L)', IINFO, N, JTYPE,
01057      $            IOLDSD
01058                INFO = ABS( IINFO )
01059                IF( IINFO.LT.0 )
01060      $            GO TO 240
01061             ELSE
01062 *
01063 *              Test 14:  | YA - WY | / ( |A| |Y| ulp )
01064 *
01065 *                        (from inverse iteration)
01066 *
01067                CALL ZGET22( 'C', 'N', 'C', N, A, LDA, EVECTY, LDU, W3,
01068      $                      WORK, RWORK, DUMMA( 3 ) )
01069                IF( DUMMA( 3 ).LT.ULPINV )
01070      $            RESULT( 14 ) = DUMMA( 3 )*ANINV
01071             END IF
01072 *
01073 *           End of Loop -- Check for RESULT(j) > THRESH
01074 *
01075   240       CONTINUE
01076 *
01077             NTESTT = NTESTT + NTEST
01078             CALL DLAFTS( 'ZHS', N, N, JTYPE, NTEST, RESULT, IOLDSD,
01079      $                   THRESH, NOUNIT, NERRS )
01080 *
01081   250    CONTINUE
01082   260 CONTINUE
01083 *
01084 *     Summary
01085 *
01086       CALL DLASUM( 'ZHS', NOUNIT, NERRS, NTESTT )
01087 *
01088       RETURN
01089 *
01090  9999 FORMAT( ' ZCHKHS: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
01091      $      I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
01092  9998 FORMAT( ' ZCHKHS: ', A, ' Eigenvectors from ', A, ' incorrectly ',
01093      $      'normalized.', / ' Bits of error=', 0P, G10.3, ',', 9X,
01094      $      'N=', I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5,
01095      $      ')' )
01096  9997 FORMAT( ' ZCHKHS: Selected ', A, ' Eigenvectors from ', A,
01097      $      ' do not match other eigenvectors ', 9X, 'N=', I6,
01098      $      ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
01099 *
01100 *     End of ZCHKHS
01101 *
01102       END
 All Files Functions