LAPACK: TESTING/EIG/cdrvst.f Source File

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