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