sdrvst()

subroutine sdrvst	(	integer	nsizes,
		integer, dimension( * )	nn,
		integer	ntypes,
		logical, dimension( * )	dotype,
		integer, dimension( 4 )	iseed,
		real	thresh,
		integer	nounit,
		real, dimension( lda, * )	a,
		integer	lda,
		real, dimension( * )	d1,
		real, dimension( * )	d2,
		real, dimension( * )	d3,
		real, dimension( * )	d4,
		real, dimension( * )	eveigs,
		real, dimension( * )	wa1,
		real, dimension( * )	wa2,
		real, dimension( * )	wa3,
		real, dimension( ldu, * )	u,
		integer	ldu,
		real, dimension( ldu, * )	v,
		real, dimension( * )	tau,
		real, dimension( ldu, * )	z,
		real, dimension( * )	work,
		integer	lwork,
		integer, dimension( * )	iwork,
		integer	liwork,
		real, dimension( * )	result,
		integer	info )

SDRVST

Purpose:

!>
!>      SDRVST  checks the symmetric eigenvalue problem drivers.
!>
!>              SSTEV computes all eigenvalues and, optionally,
!>              eigenvectors of a real symmetric tridiagonal matrix.
!>
!>              SSTEVX computes selected eigenvalues and, optionally,
!>              eigenvectors of a real symmetric tridiagonal matrix.
!>
!>              SSTEVR computes selected eigenvalues and, optionally,
!>              eigenvectors of a real symmetric tridiagonal matrix
!>              using the Relatively Robust Representation where it can.
!>
!>              SSYEV computes all eigenvalues and, optionally,
!>              eigenvectors of a real symmetric matrix.
!>
!>              SSYEVX computes selected eigenvalues and, optionally,
!>              eigenvectors of a real symmetric matrix.
!>
!>              SSYEVR computes selected eigenvalues and, optionally,
!>              eigenvectors of a real symmetric matrix
!>              using the Relatively Robust Representation where it can.
!>
!>              SSPEV computes all eigenvalues and, optionally,
!>              eigenvectors of a real symmetric matrix in packed
!>              storage.
!>
!>              SSPEVX computes selected eigenvalues and, optionally,
!>              eigenvectors of a real symmetric matrix in packed
!>              storage.
!>
!>              SSBEV computes all eigenvalues and, optionally,
!>              eigenvectors of a real symmetric band matrix.
!>
!>              SSBEVX computes selected eigenvalues and, optionally,
!>              eigenvectors of a real symmetric band matrix.
!>
!>              SSYEVD computes all eigenvalues and, optionally,
!>              eigenvectors of a real symmetric matrix using
!>              a divide and conquer algorithm.
!>
!>              SSPEVD computes all eigenvalues and, optionally,
!>              eigenvectors of a real symmetric matrix in packed
!>              storage, using a divide and conquer algorithm.
!>
!>              SSBEVD computes all eigenvalues and, optionally,
!>              eigenvectors of a real symmetric band matrix,
!>              using a divide and conquer algorithm.
!>
!>      When SDRVST is called, a number of matrix  () and a
!>      number of matrix  are specified.  For each size ()
!>      and each type of matrix, one matrix will be generated and used
!>      to test the appropriate drivers.  For each matrix and each
!>      driver routine called, the following tests will be performed:
!>
!>      (1)     | A - Z D Z' | / ( |A| n ulp )
!>
!>      (2)     | I - Z Z' | / ( n ulp )
!>
!>      (3)     | D1 - D2 | / ( |D1| ulp )
!>
!>      where Z is the matrix of eigenvectors returned when the
!>      eigenvector option is given and D1 and D2 are the eigenvalues
!>      returned with and without the eigenvector option.
!>
!>      The  are specified by an array NN(1:NSIZES); the value of
!>      each element NN(j) specifies one size.
!>      The  are specified by a logical array DOTYPE( 1:NTYPES );
!>      if DOTYPE(j) is .TRUE., then matrix type  will be generated.
!>      Currently, the list of possible types is:
!>
!>      (1)  The zero matrix.
!>      (2)  The identity matrix.
!>
!>      (3)  A diagonal matrix with evenly spaced eigenvalues
!>           1, ..., ULP  and random signs.
!>           (ULP = (first number larger than 1) - 1 )
!>      (4)  A diagonal matrix with geometrically spaced eigenvalues
!>           1, ..., ULP  and random signs.
!>      (5)  A diagonal matrix with  eigenvalues
!>           1, ULP, ..., ULP and random signs.
!>
!>      (6)  Same as (4), but multiplied by SQRT( overflow threshold )
!>      (7)  Same as (4), but multiplied by SQRT( underflow threshold )
!>
!>      (8)  A matrix of the form  U' D U, where U is orthogonal and
!>           D has evenly spaced entries 1, ..., ULP with random signs
!>           on the diagonal.
!>
!>      (9)  A matrix of the form  U' D U, where U is orthogonal and
!>           D has geometrically spaced entries 1, ..., ULP with random
!>           signs on the diagonal.
!>
!>      (10) A matrix of the form  U' D U, where U is orthogonal and
!>           D has  entries 1, ULP,..., ULP with random
!>           signs on the diagonal.
!>
!>      (11) Same as (8), but multiplied by SQRT( overflow threshold )
!>      (12) Same as (8), but multiplied by SQRT( underflow threshold )
!>
!>      (13) Symmetric matrix with random entries chosen from (-1,1).
!>      (14) Same as (13), but multiplied by SQRT( overflow threshold )
!>      (15) Same as (13), but multiplied by SQRT( underflow threshold )
!>      (16) A band matrix with half bandwidth randomly chosen between
!>           0 and N-1, with evenly spaced eigenvalues 1, ..., ULP
!>           with random signs.
!>      (17) Same as (16), but multiplied by SQRT( overflow threshold )
!>      (18) Same as (16), but multiplied by SQRT( underflow threshold )
!> 

!>  NSIZES  INTEGER
!>          The number of sizes of matrices to use.  If it is zero,
!>          SDRVST does nothing.  It must be at least zero.
!>          Not modified.
!>
!>  NN      INTEGER array, dimension (NSIZES)
!>          An array containing the sizes to be used for the matrices.
!>          Zero values will be skipped.  The values must be at least
!>          zero.
!>          Not modified.
!>
!>  NTYPES  INTEGER
!>          The number of elements in DOTYPE.   If it is zero, SDRVST
!>          does nothing.  It must be at least zero.  If it is MAXTYP+1
!>          and NSIZES is 1, then an additional type, MAXTYP+1 is
!>          defined, which is to use whatever matrix is in A.  This
!>          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
!>          DOTYPE(MAXTYP+1) is .TRUE. .
!>          Not modified.
!>
!>  DOTYPE  LOGICAL array, dimension (NTYPES)
!>          If DOTYPE(j) is .TRUE., then for each size in NN a
!>          matrix of that size and of type j will be generated.
!>          If NTYPES is smaller than the maximum number of types
!>          defined (PARAMETER MAXTYP), then types NTYPES+1 through
!>          MAXTYP will not be generated.  If NTYPES is larger
!>          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
!>          will be ignored.
!>          Not modified.
!>
!>  ISEED   INTEGER array, dimension (4)
!>          On entry ISEED specifies the seed of the random number
!>          generator. The array elements should be between 0 and 4095;
!>          if not they will be reduced mod 4096.  Also, ISEED(4) must
!>          be odd.  The random number generator uses a linear
!>          congruential sequence limited to small integers, and so
!>          should produce machine independent random numbers. The
!>          values of ISEED are changed on exit, and can be used in the
!>          next call to SDRVST to continue the same random number
!>          sequence.
!>          Modified.
!>
!>  THRESH  REAL
!>          A test will count as  if the , computed as
!>          described above, exceeds THRESH.  Note that the error
!>          is scaled to be O(1), so THRESH should be a reasonably
!>          small multiple of 1, e.g., 10 or 100.  In particular,
!>          it should not depend on the precision (single vs. double)
!>          or the size of the matrix.  It must be at least zero.
!>          Not modified.
!>
!>  NOUNIT  INTEGER
!>          The FORTRAN unit number for printing out error messages
!>          (e.g., if a routine returns IINFO not equal to 0.)
!>          Not modified.
!>
!>  A       REAL array, dimension (LDA , max(NN))
!>          Used to hold the matrix whose eigenvalues are to be
!>          computed.  On exit, A contains the last matrix actually
!>          used.
!>          Modified.
!>
!>  LDA     INTEGER
!>          The leading dimension of A.  It must be at
!>          least 1 and at least max( NN ).
!>          Not modified.
!>
!>  D1      REAL array, dimension (max(NN))
!>          The eigenvalues of A, as computed by SSTEQR simultaneously
!>          with Z.  On exit, the eigenvalues in D1 correspond with the
!>          matrix in A.
!>          Modified.
!>
!>  D2      REAL array, dimension (max(NN))
!>          The eigenvalues of A, as computed by SSTEQR if Z is not
!>          computed.  On exit, the eigenvalues in D2 correspond with
!>          the matrix in A.
!>          Modified.
!>
!>  D3      REAL array, dimension (max(NN))
!>          The eigenvalues of A, as computed by SSTERF.  On exit, the
!>          eigenvalues in D3 correspond with the matrix in A.
!>          Modified.
!>
!>  D4      REAL array, dimension
!>
!>  EVEIGS  REAL array, dimension (max(NN))
!>          The eigenvalues as computed by SSTEV('N', ... )
!>          (I reserve the right to change this to the output of
!>          whichever algorithm computes the most accurate eigenvalues).
!>
!>  WA1     REAL array, dimension
!>
!>  WA2     REAL array, dimension
!>
!>  WA3     REAL array, dimension
!>
!>  U       REAL array, dimension (LDU, max(NN))
!>          The orthogonal matrix computed by SSYTRD + SORGTR.
!>          Modified.
!>
!>  LDU     INTEGER
!>          The leading dimension of U, Z, and V.  It must be at
!>          least 1 and at least max( NN ).
!>          Not modified.
!>
!>  V       REAL array, dimension (LDU, max(NN))
!>          The Housholder vectors computed by SSYTRD in reducing A to
!>          tridiagonal form.
!>          Modified.
!>
!>  TAU     REAL array, dimension (max(NN))
!>          The Householder factors computed by SSYTRD in reducing A
!>          to tridiagonal form.
!>          Modified.
!>
!>  Z       REAL array, dimension (LDU, max(NN))
!>          The orthogonal matrix of eigenvectors computed by SSTEQR,
!>          SPTEQR, and SSTEIN.
!>          Modified.
!>
!>  WORK    REAL array, dimension (LWORK)
!>          Workspace.
!>          Modified.
!>
!>  LWORK   INTEGER
!>          The number of entries in WORK.  This must be at least
!>          1 + 4 * Nmax + 2 * Nmax * lg Nmax + 4 * Nmax**2
!>          where Nmax = max( NN(j), 2 ) and lg = log base 2.
!>          Not modified.
!>
!>  IWORK   INTEGER array,
!>             dimension (6 + 6*Nmax + 5 * Nmax * lg Nmax )
!>          where Nmax = max( NN(j), 2 ) and lg = log base 2.
!>          Workspace.
!>          Modified.
!>
!>  RESULT  REAL array, dimension (105)
!>          The values computed by the tests described above.
!>          The values are currently limited to 1/ulp, to avoid
!>          overflow.
!>          Modified.
!>
!>  INFO    INTEGER
!>          If 0, then everything ran OK.
!>           -1: NSIZES < 0
!>           -2: Some NN(j) < 0
!>           -3: NTYPES < 0
!>           -5: THRESH < 0
!>           -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
!>          -16: LDU < 1 or LDU < NMAX.
!>          -21: LWORK too small.
!>          If  SLATMR, SLATMS, SSYTRD, SORGTR, SSTEQR, SSTERF,
!>              or SORMTR returns an error code, the
!>              absolute value of it is returned.
!>          Modified.
!>
!>-----------------------------------------------------------------------
!>
!>       Some Local Variables and Parameters:
!>       ---- ----- --------- --- ----------
!>       ZERO, ONE       Real 0 and 1.
!>       MAXTYP          The number of types defined.
!>       NTEST           The number of tests performed, or which can
!>                       be performed so far, for the current matrix.
!>       NTESTT          The total number of tests performed so far.
!>       NMAX            Largest value in NN.
!>       NMATS           The number of matrices generated so far.
!>       NERRS           The number of tests which have exceeded THRESH
!>                       so far (computed by SLAFTS).
!>       COND, IMODE     Values to be passed to the matrix generators.
!>       ANORM           Norm of A; passed to matrix generators.
!>
!>       OVFL, UNFL      Overflow and underflow thresholds.
!>       ULP, ULPINV     Finest relative precision and its inverse.
!>       RTOVFL, RTUNFL  Square roots of the previous 2 values.
!>               The following four arrays decode JTYPE:
!>       KTYPE(j)        The general type (1-10) for type .
!>       KMODE(j)        The MODE value to be passed to the matrix
!>                       generator for type .
!>       KMAGN(j)        The order of magnitude ( O(1),
!>                       O(overflow^(1/2) ), O(underflow^(1/2) )
!>
!>     The tests performed are:                 Routine tested
!>    1= | A - U S U' | / ( |A| n ulp )         SSTEV('V', ... )
!>    2= | I - U U' | / ( n ulp )               SSTEV('V', ... )
!>    3= |D(with Z) - D(w/o Z)| / (|D| ulp)     SSTEV('N', ... )
!>    4= | A - U S U' | / ( |A| n ulp )         SSTEVX('V','A', ... )
!>    5= | I - U U' | / ( n ulp )               SSTEVX('V','A', ... )
!>    6= |D(with Z) - EVEIGS| / (|D| ulp)       SSTEVX('N','A', ... )
!>    7= | A - U S U' | / ( |A| n ulp )         SSTEVR('V','A', ... )
!>    8= | I - U U' | / ( n ulp )               SSTEVR('V','A', ... )
!>    9= |D(with Z) - EVEIGS| / (|D| ulp)       SSTEVR('N','A', ... )
!>    10= | A - U S U' | / ( |A| n ulp )        SSTEVX('V','I', ... )
!>    11= | I - U U' | / ( n ulp )              SSTEVX('V','I', ... )
!>    12= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSTEVX('N','I', ... )
!>    13= | A - U S U' | / ( |A| n ulp )        SSTEVX('V','V', ... )
!>    14= | I - U U' | / ( n ulp )              SSTEVX('V','V', ... )
!>    15= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSTEVX('N','V', ... )
!>    16= | A - U S U' | / ( |A| n ulp )        SSTEVD('V', ... )
!>    17= | I - U U' | / ( n ulp )              SSTEVD('V', ... )
!>    18= |D(with Z) - EVEIGS| / (|D| ulp)      SSTEVD('N', ... )
!>    19= | A - U S U' | / ( |A| n ulp )        SSTEVR('V','I', ... )
!>    20= | I - U U' | / ( n ulp )              SSTEVR('V','I', ... )
!>    21= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSTEVR('N','I', ... )
!>    22= | A - U S U' | / ( |A| n ulp )        SSTEVR('V','V', ... )
!>    23= | I - U U' | / ( n ulp )              SSTEVR('V','V', ... )
!>    24= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSTEVR('N','V', ... )
!>
!>    25= | A - U S U' | / ( |A| n ulp )        SSYEV('L','V', ... )
!>    26= | I - U U' | / ( n ulp )              SSYEV('L','V', ... )
!>    27= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSYEV('L','N', ... )
!>    28= | A - U S U' | / ( |A| n ulp )        SSYEVX('L','V','A', ... )
!>    29= | I - U U' | / ( n ulp )              SSYEVX('L','V','A', ... )
!>    30= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSYEVX('L','N','A', ... )
!>    31= | A - U S U' | / ( |A| n ulp )        SSYEVX('L','V','I', ... )
!>    32= | I - U U' | / ( n ulp )              SSYEVX('L','V','I', ... )
!>    33= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSYEVX('L','N','I', ... )
!>    34= | A - U S U' | / ( |A| n ulp )        SSYEVX('L','V','V', ... )
!>    35= | I - U U' | / ( n ulp )              SSYEVX('L','V','V', ... )
!>    36= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSYEVX('L','N','V', ... )
!>    37= | A - U S U' | / ( |A| n ulp )        SSPEV('L','V', ... )
!>    38= | I - U U' | / ( n ulp )              SSPEV('L','V', ... )
!>    39= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSPEV('L','N', ... )
!>    40= | A - U S U' | / ( |A| n ulp )        SSPEVX('L','V','A', ... )
!>    41= | I - U U' | / ( n ulp )              SSPEVX('L','V','A', ... )
!>    42= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSPEVX('L','N','A', ... )
!>    43= | A - U S U' | / ( |A| n ulp )        SSPEVX('L','V','I', ... )
!>    44= | I - U U' | / ( n ulp )              SSPEVX('L','V','I', ... )
!>    45= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSPEVX('L','N','I', ... )
!>    46= | A - U S U' | / ( |A| n ulp )        SSPEVX('L','V','V', ... )
!>    47= | I - U U' | / ( n ulp )              SSPEVX('L','V','V', ... )
!>    48= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSPEVX('L','N','V', ... )
!>    49= | A - U S U' | / ( |A| n ulp )        SSBEV('L','V', ... )
!>    50= | I - U U' | / ( n ulp )              SSBEV('L','V', ... )
!>    51= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSBEV('L','N', ... )
!>    52= | A - U S U' | / ( |A| n ulp )        SSBEVX('L','V','A', ... )
!>    53= | I - U U' | / ( n ulp )              SSBEVX('L','V','A', ... )
!>    54= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSBEVX('L','N','A', ... )
!>    55= | A - U S U' | / ( |A| n ulp )        SSBEVX('L','V','I', ... )
!>    56= | I - U U' | / ( n ulp )              SSBEVX('L','V','I', ... )
!>    57= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSBEVX('L','N','I', ... )
!>    58= | A - U S U' | / ( |A| n ulp )        SSBEVX('L','V','V', ... )
!>    59= | I - U U' | / ( n ulp )              SSBEVX('L','V','V', ... )
!>    60= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSBEVX('L','N','V', ... )
!>    61= | A - U S U' | / ( |A| n ulp )        SSYEVD('L','V', ... )
!>    62= | I - U U' | / ( n ulp )              SSYEVD('L','V', ... )
!>    63= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSYEVD('L','N', ... )
!>    64= | A - U S U' | / ( |A| n ulp )        SSPEVD('L','V', ... )
!>    65= | I - U U' | / ( n ulp )              SSPEVD('L','V', ... )
!>    66= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSPEVD('L','N', ... )
!>    67= | A - U S U' | / ( |A| n ulp )        SSBEVD('L','V', ... )
!>    68= | I - U U' | / ( n ulp )              SSBEVD('L','V', ... )
!>    69= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSBEVD('L','N', ... )
!>    70= | A - U S U' | / ( |A| n ulp )        SSYEVR('L','V','A', ... )
!>    71= | I - U U' | / ( n ulp )              SSYEVR('L','V','A', ... )
!>    72= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSYEVR('L','N','A', ... )
!>    73= | A - U S U' | / ( |A| n ulp )        SSYEVR('L','V','I', ... )
!>    74= | I - U U' | / ( n ulp )              SSYEVR('L','V','I', ... )
!>    75= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSYEVR('L','N','I', ... )
!>    76= | A - U S U' | / ( |A| n ulp )        SSYEVR('L','V','V', ... )
!>    77= | I - U U' | / ( n ulp )              SSYEVR('L','V','V', ... )
!>    78= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSYEVR('L','N','V', ... )
!>
!>    Tests 25 through 78 are repeated (as tests 79 through 132)
!>    with UPLO='U'
!>
!>    To be added in 1999
!>
!>    79= | A - U S U' | / ( |A| n ulp )        SSPEVR('L','V','A', ... )
!>    80= | I - U U' | / ( n ulp )              SSPEVR('L','V','A', ... )
!>    81= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSPEVR('L','N','A', ... )
!>    82= | A - U S U' | / ( |A| n ulp )        SSPEVR('L','V','I', ... )
!>    83= | I - U U' | / ( n ulp )              SSPEVR('L','V','I', ... )
!>    84= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSPEVR('L','N','I', ... )
!>    85= | A - U S U' | / ( |A| n ulp )        SSPEVR('L','V','V', ... )
!>    86= | I - U U' | / ( n ulp )              SSPEVR('L','V','V', ... )
!>    87= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSPEVR('L','N','V', ... )
!>    88= | A - U S U' | / ( |A| n ulp )        SSBEVR('L','V','A', ... )
!>    89= | I - U U' | / ( n ulp )              SSBEVR('L','V','A', ... )
!>    90= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSBEVR('L','N','A', ... )
!>    91= | A - U S U' | / ( |A| n ulp )        SSBEVR('L','V','I', ... )
!>    92= | I - U U' | / ( n ulp )              SSBEVR('L','V','I', ... )
!>    93= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSBEVR('L','N','I', ... )
!>    94= | A - U S U' | / ( |A| n ulp )        SSBEVR('L','V','V', ... )
!>    95= | I - U U' | / ( n ulp )              SSBEVR('L','V','V', ... )
!>    96= |D(with Z) - D(w/o Z)| / (|D| ulp)    SSBEVR('L','N','V', ... )
!> 

Author

Univ. of Tennessee

Univ. of California Berkeley

Univ. of Colorado Denver

NAG Ltd.

Definition at line 449 of file sdrvst.f.

*
*  -- LAPACK test routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      INTEGER            INFO, LDA, LDU, LIWORK, LWORK, NOUNIT, NSIZES,
     $                   NTYPES
      REAL               THRESH
*     ..
*     .. Array Arguments ..
      LOGICAL            DOTYPE( * )
      INTEGER            ISEED( 4 ), IWORK( * ), NN( * )
      REAL               A( LDA, * ), D1( * ), D2( * ), D3( * ),
     $                   D4( * ), EVEIGS( * ), RESULT( * ), TAU( * ),
     $                   U( LDU, * ), V( LDU, * ), WA1( * ), WA2( * ),
     $                   WA3( * ), WORK( * ), Z( LDU, * )
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      REAL               ZERO, ONE, TWO, TEN
      parameter( zero = 0.0e0, one = 1.0e0, two = 2.0e0,
     $                   ten = 10.0e0 )
      REAL               HALF
      parameter( half = 0.5e0 )
      INTEGER            MAXTYP
      parameter( maxtyp = 18 )
*     ..
*     .. Local Scalars ..
      LOGICAL            BADNN
      CHARACTER          UPLO
      INTEGER            I, IDIAG, IHBW, IINFO, IL, IMODE, INDX, IROW,
     $                   ITEMP, ITYPE, IU, IUPLO, J, J1, J2, JCOL,
     $                   JSIZE, JTYPE, KD, LGN, LIWEDC, LWEDC, M, M2,
     $                   M3, MTYPES, N, NERRS, NMATS, NMAX, NTEST,
     $                   NTESTT
      REAL               ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
     $                   RTUNFL, TEMP1, TEMP2, TEMP3, ULP, ULPINV, UNFL,
     $                   VL, VU
*     ..
*     .. Local Arrays ..
      INTEGER            IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
     $                   ISEED3( 4 ), KMAGN( MAXTYP ), KMODE( MAXTYP ),
     $                   KTYPE( MAXTYP )
*     ..
*     .. External Functions ..
      REAL               SLAMCH, SLARND, SSXT1
      EXTERNAL           slamch, slarnd, ssxt1
*     ..
*     .. External Subroutines ..
      EXTERNAL           alasvm, slacpy, slafts, slaset, slatmr, slatms,
     $                   ssbev, ssbevd, ssbevx, sspev, sspevd, sspevx,
     $                   sstev, sstevd, sstevr, sstevx, sstt21, sstt22,
     $                   ssyev, ssyevd, ssyevr, ssyevx, ssyt21, ssyt22,
     $                   xerbla
*     ..
*     .. Scalars in Common ..
      CHARACTER*32       SRNAMT
*     ..
*     .. Common blocks ..
      COMMON             / srnamc / srnamt
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          abs, int, log, max, min, real, sqrt
*     ..
*     .. Data statements ..
      DATA               ktype / 1, 2, 5*4, 5*5, 3*8, 3*9 /
      DATA               kmagn / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
     $                   2, 3, 1, 2, 3 /
      DATA               kmode / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
     $                   0, 0, 4, 4, 4 /
*     ..
*     .. Executable Statements ..
*
*     Keep ftrnchek happy
*
      vl = zero
      vu = zero
*
*     1)      Check for errors
*
      ntestt = 0
      info = 0
*
      badnn = .false.
      nmax = 1
      DO 10 j = 1, nsizes
         nmax = max( nmax, nn( j ) )
         IF( nn( j ).LT.0 )
     $      badnn = .true.
   10 CONTINUE
*
*     Check for errors
*
      IF( nsizes.LT.0 ) THEN
         info = -1
      ELSE IF( badnn ) THEN
         info = -2
      ELSE IF( ntypes.LT.0 ) THEN
         info = -3
      ELSE IF( lda.LT.nmax ) THEN
         info = -9
      ELSE IF( ldu.LT.nmax ) THEN
         info = -16
      ELSE IF( 2*max( 2, nmax )**2.GT.lwork ) THEN
         info = -21
      END IF
*
      IF( info.NE.0 ) THEN
         CALL xerbla( 'SDRVST', -info )
         RETURN
      END IF
*
*     Quick return if nothing to do
*
      IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
     $   RETURN
*
*     More Important constants
*
      unfl = slamch( 'Safe minimum' )
      ovfl = slamch( 'Overflow' )
      ulp = slamch( 'Epsilon' )*slamch( 'Base' )
      ulpinv = one / ulp
      rtunfl = sqrt( unfl )
      rtovfl = sqrt( ovfl )
*
*     Loop over sizes, types
*
      DO 20 i = 1, 4
         iseed2( i ) = iseed( i )
         iseed3( i ) = iseed( i )
   20 CONTINUE
*
      nerrs = 0
      nmats = 0
*
*
      DO 1740 jsize = 1, nsizes
         n = nn( jsize )
         IF( n.GT.0 ) THEN
            lgn = int( log( real( n ) ) / log( two ) )
            IF( 2**lgn.LT.n )
     $         lgn = lgn + 1
            IF( 2**lgn.LT.n )
     $         lgn = lgn + 1
            lwedc = 1 + 4*n + 2*n*lgn + 4*n**2
c           LIWEDC = 6 + 6*N + 5*N*LGN
            liwedc = 3 + 5*n
         ELSE
            lwedc = 9
c           LIWEDC = 12
            liwedc = 8
         END IF
         aninv = one / real( max( 1, n ) )
*
         IF( nsizes.NE.1 ) THEN
            mtypes = min( maxtyp, ntypes )
         ELSE
            mtypes = min( maxtyp+1, ntypes )
         END IF
*
         DO 1730 jtype = 1, mtypes
*
            IF( .NOT.dotype( jtype ) )
     $         GO TO 1730
            nmats = nmats + 1
            ntest = 0
*
            DO 30 j = 1, 4
               ioldsd( j ) = iseed( j )
   30       CONTINUE
*
*           2)      Compute "A"
*
*                   Control parameters:
*
*               KMAGN  KMODE        KTYPE
*           =1  O(1)   clustered 1  zero
*           =2  large  clustered 2  identity
*           =3  small  exponential  (none)
*           =4         arithmetic   diagonal, (w/ eigenvalues)
*           =5         random log   symmetric, w/ eigenvalues
*           =6         random       (none)
*           =7                      random diagonal
*           =8                      random symmetric
*           =9                      band symmetric, w/ eigenvalues
*
            IF( mtypes.GT.maxtyp )
     $         GO TO 110
*
            itype = ktype( jtype )
            imode = kmode( jtype )
*
*           Compute norm
*
            GO TO ( 40, 50, 60 )kmagn( jtype )
*
   40       CONTINUE
            anorm = one
            GO TO 70
*
   50       CONTINUE
            anorm = ( rtovfl*ulp )*aninv
            GO TO 70
*
   60       CONTINUE
            anorm = rtunfl*n*ulpinv
            GO TO 70
*
   70       CONTINUE
*
            CALL slaset( 'Full', lda, n, zero, zero, a, lda )
            iinfo = 0
            cond = ulpinv
*
*           Special Matrices -- Identity & Jordan block
*
*                   Zero
*
            IF( itype.EQ.1 ) THEN
               iinfo = 0
*
            ELSE IF( itype.EQ.2 ) THEN
*
*              Identity
*
               DO 80 jcol = 1, n
                  a( jcol, jcol ) = anorm
   80          CONTINUE
*
            ELSE IF( itype.EQ.4 ) THEN
*
*              Diagonal Matrix, [Eigen]values Specified
*
               CALL slatms( n, n, 'S', iseed, 'S', work, imode, cond,
     $                      anorm, 0, 0, 'N', a, lda, work( n+1 ),
     $                      iinfo )
*
            ELSE IF( itype.EQ.5 ) THEN
*
*              Symmetric, eigenvalues specified
*
               CALL slatms( n, n, 'S', iseed, 'S', work, imode, cond,
     $                      anorm, n, n, 'N', a, lda, work( n+1 ),
     $                      iinfo )
*
            ELSE IF( itype.EQ.7 ) THEN
*
*              Diagonal, random eigenvalues
*
               idumma( 1 ) = 1
               CALL slatmr( n, n, 'S', iseed, 'S', work, 6, one, one,
     $                      'T', 'N', work( n+1 ), 1, one,
     $                      work( 2*n+1 ), 1, one, 'N', idumma, 0, 0,
     $                      zero, anorm, 'NO', a, lda, iwork, iinfo )
*
            ELSE IF( itype.EQ.8 ) THEN
*
*              Symmetric, random eigenvalues
*
               idumma( 1 ) = 1
               CALL slatmr( n, n, 'S', iseed, 'S', work, 6, one, one,
     $                      'T', 'N', work( n+1 ), 1, one,
     $                      work( 2*n+1 ), 1, one, 'N', idumma, n, n,
     $                      zero, anorm, 'NO', a, lda, iwork, iinfo )
*
            ELSE IF( itype.EQ.9 ) THEN
*
*              Symmetric banded, eigenvalues specified
*
               ihbw = int( ( n-1 )*slarnd( 1, iseed3 ) )
               CALL slatms( n, n, 'S', iseed, 'S', work, imode, cond,
     $                      anorm, ihbw, ihbw, 'Z', u, ldu, work( n+1 ),
     $                      iinfo )
*
*              Store as dense matrix for most routines.
*
               CALL slaset( 'Full', lda, n, zero, zero, a, lda )
               DO 100 idiag = -ihbw, ihbw
                  irow = ihbw - idiag + 1
                  j1 = max( 1, idiag+1 )
                  j2 = min( n, n+idiag )
                  DO 90 j = j1, j2
                     i = j - idiag
                     a( i, j ) = u( irow, j )
   90             CONTINUE
  100          CONTINUE
            ELSE
               iinfo = 1
            END IF
*
            IF( iinfo.NE.0 ) THEN
               WRITE( nounit, fmt = 9999 )'Generator', iinfo, n, jtype,
     $            ioldsd
               info = abs( iinfo )
               RETURN
            END IF
*
  110       CONTINUE
*
            abstol = unfl + unfl
            IF( n.LE.1 ) THEN
               il = 1
               iu = n
            ELSE
               il = 1 + int( ( n-1 )*slarnd( 1, iseed2 ) )
               iu = 1 + int( ( n-1 )*slarnd( 1, iseed2 ) )
               IF( il.GT.iu ) THEN
                  itemp = il
                  il = iu
                  iu = itemp
               END IF
            END IF
*
*           3)      If matrix is tridiagonal, call SSTEV and SSTEVX.
*
            IF( jtype.LE.7 ) THEN
               ntest = 1
               DO 120 i = 1, n
                  d1( i ) = real( a( i, i ) )
  120          CONTINUE
               DO 130 i = 1, n - 1
                  d2( i ) = real( a( i+1, i ) )
  130          CONTINUE
               srnamt = 'SSTEV'
               CALL sstev( 'V', n, d1, d2, z, ldu, work, iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSTEV(V)', iinfo, n,
     $               jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( 1 ) = ulpinv
                     result( 2 ) = ulpinv
                     result( 3 ) = ulpinv
                     GO TO 180
                  END IF
               END IF
*
*              Do tests 1 and 2.
*
               DO 140 i = 1, n
                  d3( i ) = real( a( i, i ) )
  140          CONTINUE
               DO 150 i = 1, n - 1
                  d4( i ) = real( a( i+1, i ) )
  150          CONTINUE
               CALL sstt21( n, 0, d3, d4, d1, d2, z, ldu, work,
     $                      result( 1 ) )
*
               ntest = 3
               DO 160 i = 1, n - 1
                  d4( i ) = real( a( i+1, i ) )
  160          CONTINUE
               srnamt = 'SSTEV'
               CALL sstev( 'N', n, d3, d4, z, ldu, work, iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSTEV(N)', iinfo, n,
     $               jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( 3 ) = ulpinv
                     GO TO 180
                  END IF
               END IF
*
*              Do test 3.
*
               temp1 = zero
               temp2 = zero
               DO 170 j = 1, n
                  temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
                  temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
  170          CONTINUE
               result( 3 ) = temp2 / max( unfl,
     $                       ulp*max( temp1, temp2 ) )
*
  180          CONTINUE
*
               ntest = 4
               DO 190 i = 1, n
                  eveigs( i ) = d3( i )
                  d1( i ) = real( a( i, i ) )
  190          CONTINUE
               DO 200 i = 1, n - 1
                  d2( i ) = real( a( i+1, i ) )
  200          CONTINUE
               srnamt = 'SSTEVX'
               CALL sstevx( 'V', 'A', n, d1, d2, vl, vu, il, iu, abstol,
     $                      m, wa1, z, ldu, work, iwork, iwork( 5*n+1 ),
     $                      iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSTEVX(V,A)', iinfo, n,
     $               jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( 4 ) = ulpinv
                     result( 5 ) = ulpinv
                     result( 6 ) = ulpinv
                     GO TO 250
                  END IF
               END IF
               IF( n.GT.0 ) THEN
                  temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
               ELSE
                  temp3 = zero
               END IF
*
*              Do tests 4 and 5.
*
               DO 210 i = 1, n
                  d3( i ) = real( a( i, i ) )
  210          CONTINUE
               DO 220 i = 1, n - 1
                  d4( i ) = real( a( i+1, i ) )
  220          CONTINUE
               CALL sstt21( n, 0, d3, d4, wa1, d2, z, ldu, work,
     $                      result( 4 ) )
*
               ntest = 6
               DO 230 i = 1, n - 1
                  d4( i ) = real( a( i+1, i ) )
  230          CONTINUE
               srnamt = 'SSTEVX'
               CALL sstevx( 'N', 'A', n, d3, d4, vl, vu, il, iu, abstol,
     $                      m2, wa2, z, ldu, work, iwork,
     $                      iwork( 5*n+1 ), iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSTEVX(N,A)', iinfo, n,
     $               jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( 6 ) = ulpinv
                     GO TO 250
                  END IF
               END IF
*
*              Do test 6.
*
               temp1 = zero
               temp2 = zero
               DO 240 j = 1, n
                  temp1 = max( temp1, abs( wa2( j ) ),
     $                    abs( eveigs( j ) ) )
                  temp2 = max( temp2, abs( wa2( j )-eveigs( j ) ) )
  240          CONTINUE
               result( 6 ) = temp2 / max( unfl,
     $                       ulp*max( temp1, temp2 ) )
*
  250          CONTINUE
*
               ntest = 7
               DO 260 i = 1, n
                  d1( i ) = real( a( i, i ) )
  260          CONTINUE
               DO 270 i = 1, n - 1
                  d2( i ) = real( a( i+1, i ) )
  270          CONTINUE
               srnamt = 'SSTEVR'
               CALL sstevr( 'V', 'A', n, d1, d2, vl, vu, il, iu, abstol,
     $                      m, wa1, z, ldu, iwork, work, lwork,
     $                      iwork(2*n+1), liwork-2*n, iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSTEVR(V,A)', iinfo, n,
     $               jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( 7 ) = ulpinv
                     result( 8 ) = ulpinv
                     GO TO 320
                  END IF
               END IF
               IF( n.GT.0 ) THEN
                  temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
               ELSE
                  temp3 = zero
               END IF
*
*              Do tests 7 and 8.
*
               DO 280 i = 1, n
                  d3( i ) = real( a( i, i ) )
  280          CONTINUE
               DO 290 i = 1, n - 1
                  d4( i ) = real( a( i+1, i ) )
  290          CONTINUE
               CALL sstt21( n, 0, d3, d4, wa1, d2, z, ldu, work,
     $                      result( 7 ) )
*
               ntest = 9
               DO 300 i = 1, n - 1
                  d4( i ) = real( a( i+1, i ) )
  300          CONTINUE
               srnamt = 'SSTEVR'
               CALL sstevr( 'N', 'A', n, d3, d4, vl, vu, il, iu, abstol,
     $                      m2, wa2, z, ldu, iwork, work, lwork,
     $                      iwork(2*n+1), liwork-2*n, iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSTEVR(N,A)', iinfo, n,
     $               jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( 9 ) = ulpinv
                     GO TO 320
                  END IF
               END IF
*
*              Do test 9.
*
               temp1 = zero
               temp2 = zero
               DO 310 j = 1, n
                  temp1 = max( temp1, abs( wa2( j ) ),
     $                    abs( eveigs( j ) ) )
                  temp2 = max( temp2, abs( wa2( j )-eveigs( j ) ) )
  310          CONTINUE
               result( 9 ) = temp2 / max( unfl,
     $                       ulp*max( temp1, temp2 ) )
*
  320          CONTINUE
*
*
               ntest = 10
               DO 330 i = 1, n
                  d1( i ) = real( a( i, i ) )
  330          CONTINUE
               DO 340 i = 1, n - 1
                  d2( i ) = real( a( i+1, i ) )
  340          CONTINUE
               srnamt = 'SSTEVX'
               CALL sstevx( 'V', 'I', n, d1, d2, vl, vu, il, iu, abstol,
     $                      m2, wa2, z, ldu, work, iwork,
     $                      iwork( 5*n+1 ), iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSTEVX(V,I)', iinfo, n,
     $               jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( 10 ) = ulpinv
                     result( 11 ) = ulpinv
                     result( 12 ) = ulpinv
                     GO TO 380
                  END IF
               END IF
*
*              Do tests 10 and 11.
*
               DO 350 i = 1, n
                  d3( i ) = real( a( i, i ) )
  350          CONTINUE
               DO 360 i = 1, n - 1
                  d4( i ) = real( a( i+1, i ) )
  360          CONTINUE
               CALL sstt22( n, m2, 0, d3, d4, wa2, d2, z, ldu, work,
     $                      max( 1, m2 ), result( 10 ) )
*
*
               ntest = 12
               DO 370 i = 1, n - 1
                  d4( i ) = real( a( i+1, i ) )
  370          CONTINUE
               srnamt = 'SSTEVX'
               CALL sstevx( 'N', 'I', n, d3, d4, vl, vu, il, iu, abstol,
     $                      m3, wa3, z, ldu, work, iwork,
     $                      iwork( 5*n+1 ), iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSTEVX(N,I)', iinfo, n,
     $               jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( 12 ) = ulpinv
                     GO TO 380
                  END IF
               END IF
*
*              Do test 12.
*
               temp1 = ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
               temp2 = ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
               result( 12 ) = ( temp1+temp2 ) / max( unfl, ulp*temp3 )
*
  380          CONTINUE
*
               ntest = 12
               IF( n.GT.0 ) THEN
                  IF( il.NE.1 ) THEN
                     vl = wa1( il ) - max( half*
     $                    ( wa1( il )-wa1( il-1 ) ), ten*ulp*temp3,
     $                    ten*rtunfl )
                  ELSE
                     vl = wa1( 1 ) - max( half*( wa1( n )-wa1( 1 ) ),
     $                    ten*ulp*temp3, ten*rtunfl )
                  END IF
                  IF( iu.NE.n ) THEN
                     vu = wa1( iu ) + max( half*
     $                    ( wa1( iu+1 )-wa1( iu ) ), ten*ulp*temp3,
     $                    ten*rtunfl )
                  ELSE
                     vu = wa1( n ) + max( half*( wa1( n )-wa1( 1 ) ),
     $                    ten*ulp*temp3, ten*rtunfl )
                  END IF
               ELSE
                  vl = zero
                  vu = one
               END IF
*
               DO 390 i = 1, n
                  d1( i ) = real( a( i, i ) )
  390          CONTINUE
               DO 400 i = 1, n - 1
                  d2( i ) = real( a( i+1, i ) )
  400          CONTINUE
               srnamt = 'SSTEVX'
               CALL sstevx( 'V', 'V', n, d1, d2, vl, vu, il, iu, abstol,
     $                      m2, wa2, z, ldu, work, iwork,
     $                      iwork( 5*n+1 ), iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSTEVX(V,V)', iinfo, n,
     $               jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( 13 ) = ulpinv
                     result( 14 ) = ulpinv
                     result( 15 ) = ulpinv
                     GO TO 440
                  END IF
               END IF
*
               IF( m2.EQ.0 .AND. n.GT.0 ) THEN
                  result( 13 ) = ulpinv
                  result( 14 ) = ulpinv
                  result( 15 ) = ulpinv
                  GO TO 440
               END IF
*
*              Do tests 13 and 14.
*
               DO 410 i = 1, n
                  d3( i ) = real( a( i, i ) )
  410          CONTINUE
               DO 420 i = 1, n - 1
                  d4( i ) = real( a( i+1, i ) )
  420          CONTINUE
               CALL sstt22( n, m2, 0, d3, d4, wa2, d2, z, ldu, work,
     $                      max( 1, m2 ), result( 13 ) )
*
               ntest = 15
               DO 430 i = 1, n - 1
                  d4( i ) = real( a( i+1, i ) )
  430          CONTINUE
               srnamt = 'SSTEVX'
               CALL sstevx( 'N', 'V', n, d3, d4, vl, vu, il, iu, abstol,
     $                      m3, wa3, z, ldu, work, iwork,
     $                      iwork( 5*n+1 ), iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSTEVX(N,V)', iinfo, n,
     $               jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( 15 ) = ulpinv
                     GO TO 440
                  END IF
               END IF
*
*              Do test 15.
*
               temp1 = ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
               temp2 = ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
               result( 15 ) = ( temp1+temp2 ) / max( unfl, temp3*ulp )
*
  440          CONTINUE
*
               ntest = 16
               DO 450 i = 1, n
                  d1( i ) = real( a( i, i ) )
  450          CONTINUE
               DO 460 i = 1, n - 1
                  d2( i ) = real( a( i+1, i ) )
  460          CONTINUE
               srnamt = 'SSTEVD'
               CALL sstevd( 'V', n, d1, d2, z, ldu, work, lwedc, iwork,
     $                      liwedc, iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSTEVD(V)', iinfo, n,
     $               jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( 16 ) = ulpinv
                     result( 17 ) = ulpinv
                     result( 18 ) = ulpinv
                     GO TO 510
                  END IF
               END IF
*
*              Do tests 16 and 17.
*
               DO 470 i = 1, n
                  d3( i ) = real( a( i, i ) )
  470          CONTINUE
               DO 480 i = 1, n - 1
                  d4( i ) = real( a( i+1, i ) )
  480          CONTINUE
               CALL sstt21( n, 0, d3, d4, d1, d2, z, ldu, work,
     $                      result( 16 ) )
*
               ntest = 18
               DO 490 i = 1, n - 1
                  d4( i ) = real( a( i+1, i ) )
  490          CONTINUE
               srnamt = 'SSTEVD'
               CALL sstevd( 'N', n, d3, d4, z, ldu, work, lwedc, iwork,
     $                      liwedc, iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSTEVD(N)', iinfo, n,
     $               jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( 18 ) = ulpinv
                     GO TO 510
                  END IF
               END IF
*
*              Do test 18.
*
               temp1 = zero
               temp2 = zero
               DO 500 j = 1, n
                  temp1 = max( temp1, abs( eveigs( j ) ),
     $                    abs( d3( j ) ) )
                  temp2 = max( temp2, abs( eveigs( j )-d3( j ) ) )
  500          CONTINUE
               result( 18 ) = temp2 / max( unfl,
     $                        ulp*max( temp1, temp2 ) )
*
  510          CONTINUE
*
               ntest = 19
               DO 520 i = 1, n
                  d1( i ) = real( a( i, i ) )
  520          CONTINUE
               DO 530 i = 1, n - 1
                  d2( i ) = real( a( i+1, i ) )
  530          CONTINUE
               srnamt = 'SSTEVR'
               CALL sstevr( 'V', 'I', n, d1, d2, vl, vu, il, iu, abstol,
     $                      m2, wa2, z, ldu, iwork, work, lwork,
     $                      iwork(2*n+1), liwork-2*n, iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSTEVR(V,I)', iinfo, n,
     $               jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( 19 ) = ulpinv
                     result( 20 ) = ulpinv
                     result( 21 ) = ulpinv
                     GO TO 570
                  END IF
               END IF
*
*              DO tests 19 and 20.
*
               DO 540 i = 1, n
                  d3( i ) = real( a( i, i ) )
  540          CONTINUE
               DO 550 i = 1, n - 1
                  d4( i ) = real( a( i+1, i ) )
  550          CONTINUE
               CALL sstt22( n, m2, 0, d3, d4, wa2, d2, z, ldu, work,
     $                      max( 1, m2 ), result( 19 ) )
*
*
               ntest = 21
               DO 560 i = 1, n - 1
                  d4( i ) = real( a( i+1, i ) )
  560          CONTINUE
               srnamt = 'SSTEVR'
               CALL sstevr( 'N', 'I', n, d3, d4, vl, vu, il, iu, abstol,
     $                      m3, wa3, z, ldu, iwork, work, lwork,
     $                      iwork(2*n+1), liwork-2*n, iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSTEVR(N,I)', iinfo, n,
     $               jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( 21 ) = ulpinv
                     GO TO 570
                  END IF
               END IF
*
*              Do test 21.
*
               temp1 = ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
               temp2 = ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
               result( 21 ) = ( temp1+temp2 ) / max( unfl, ulp*temp3 )
*
  570          CONTINUE
*
               ntest = 21
               IF( n.GT.0 ) THEN
                  IF( il.NE.1 ) THEN
                     vl = wa1( il ) - max( half*
     $                    ( wa1( il )-wa1( il-1 ) ), ten*ulp*temp3,
     $                    ten*rtunfl )
                  ELSE
                     vl = wa1( 1 ) - max( half*( wa1( n )-wa1( 1 ) ),
     $                    ten*ulp*temp3, ten*rtunfl )
                  END IF
                  IF( iu.NE.n ) THEN
                     vu = wa1( iu ) + max( half*
     $                    ( wa1( iu+1 )-wa1( iu ) ), ten*ulp*temp3,
     $                    ten*rtunfl )
                  ELSE
                     vu = wa1( n ) + max( half*( wa1( n )-wa1( 1 ) ),
     $                    ten*ulp*temp3, ten*rtunfl )
                  END IF
               ELSE
                  vl = zero
                  vu = one
               END IF
*
               DO 580 i = 1, n
                  d1( i ) = real( a( i, i ) )
  580          CONTINUE
               DO 590 i = 1, n - 1
                  d2( i ) = real( a( i+1, i ) )
  590          CONTINUE
               srnamt = 'SSTEVR'
               CALL sstevr( 'V', 'V', n, d1, d2, vl, vu, il, iu, abstol,
     $                      m2, wa2, z, ldu, iwork, work, lwork,
     $                      iwork(2*n+1), liwork-2*n, iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSTEVR(V,V)', iinfo, n,
     $               jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( 22 ) = ulpinv
                     result( 23 ) = ulpinv
                     result( 24 ) = ulpinv
                     GO TO 630
                  END IF
               END IF
*
               IF( m2.EQ.0 .AND. n.GT.0 ) THEN
                  result( 22 ) = ulpinv
                  result( 23 ) = ulpinv
                  result( 24 ) = ulpinv
                  GO TO 630
               END IF
*
*              Do tests 22 and 23.
*
               DO 600 i = 1, n
                  d3( i ) = real( a( i, i ) )
  600          CONTINUE
               DO 610 i = 1, n - 1
                  d4( i ) = real( a( i+1, i ) )
  610          CONTINUE
               CALL sstt22( n, m2, 0, d3, d4, wa2, d2, z, ldu, work,
     $                      max( 1, m2 ), result( 22 ) )
*
               ntest = 24
               DO 620 i = 1, n - 1
                  d4( i ) = real( a( i+1, i ) )
  620          CONTINUE
               srnamt = 'SSTEVR'
               CALL sstevr( 'N', 'V', n, d3, d4, vl, vu, il, iu, abstol,
     $                      m3, wa3, z, ldu, iwork, work, lwork,
     $                      iwork(2*n+1), liwork-2*n, iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSTEVR(N,V)', iinfo, n,
     $               jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( 24 ) = ulpinv
                     GO TO 630
                  END IF
               END IF
*
*              Do test 24.
*
               temp1 = ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
               temp2 = ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
               result( 24 ) = ( temp1+temp2 ) / max( unfl, temp3*ulp )
*
  630          CONTINUE
*
*
*
            ELSE
*
               DO 640 i = 1, 24
                  result( i ) = zero
  640          CONTINUE
               ntest = 24
            END IF
*
*           Perform remaining tests storing upper or lower triangular
*           part of matrix.
*
            DO 1720 iuplo = 0, 1
               IF( iuplo.EQ.0 ) THEN
                  uplo = 'L'
               ELSE
                  uplo = 'U'
               END IF
*
*              4)      Call SSYEV and SSYEVX.
*
               CALL slacpy( ' ', n, n, a, lda, v, ldu )
*
               ntest = ntest + 1
               srnamt = 'SSYEV'
               CALL ssyev( 'V', uplo, n, a, ldu, d1, work, lwork,
     $                     iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSYEV(V,' // uplo // ')',
     $               iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     result( ntest+1 ) = ulpinv
                     result( ntest+2 ) = ulpinv
                     GO TO 660
                  END IF
               END IF
*
*              Do tests 25 and 26 (or +54)
*
               CALL ssyt21( 1, uplo, n, 0, v, ldu, d1, d2, a, ldu, z,
     $                      ldu, tau, work, result( ntest ) )
*
               CALL slacpy( ' ', n, n, v, ldu, a, lda )
*
               ntest = ntest + 2
               srnamt = 'SSYEV'
               CALL ssyev( 'N', uplo, n, a, ldu, d3, work, lwork,
     $                     iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSYEV(N,' // uplo // ')',
     $               iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     GO TO 660
                  END IF
               END IF
*
*              Do test 27 (or +54)
*
               temp1 = zero
               temp2 = zero
               DO 650 j = 1, n
                  temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
                  temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
  650          CONTINUE
               result( ntest ) = temp2 / max( unfl,
     $                           ulp*max( temp1, temp2 ) )
*
  660          CONTINUE
               CALL slacpy( ' ', n, n, v, ldu, a, lda )
*
               ntest = ntest + 1
*
               IF( n.GT.0 ) THEN
                  temp3 = max( abs( d1( 1 ) ), abs( d1( n ) ) )
                  IF( il.NE.1 ) THEN
                     vl = d1( il ) - max( half*( d1( il )-d1( il-1 ) ),
     $                    ten*ulp*temp3, ten*rtunfl )
                  ELSE IF( n.GT.0 ) THEN
                     vl = d1( 1 ) - max( half*( d1( n )-d1( 1 ) ),
     $                    ten*ulp*temp3, ten*rtunfl )
                  END IF
                  IF( iu.NE.n ) THEN
                     vu = d1( iu ) + max( half*( d1( iu+1 )-d1( iu ) ),
     $                    ten*ulp*temp3, ten*rtunfl )
                  ELSE IF( n.GT.0 ) THEN
                     vu = d1( n ) + max( half*( d1( n )-d1( 1 ) ),
     $                    ten*ulp*temp3, ten*rtunfl )
                  END IF
               ELSE
                  temp3 = zero
                  vl = zero
                  vu = one
               END IF
*
               srnamt = 'SSYEVX'
               CALL ssyevx( 'V', 'A', uplo, n, a, ldu, vl, vu, il, iu,
     $                      abstol, m, wa1, z, ldu, work, lwork, iwork,
     $                      iwork( 5*n+1 ), iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSYEVX(V,A,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     result( ntest+1 ) = ulpinv
                     result( ntest+2 ) = ulpinv
                     GO TO 680
                  END IF
               END IF
*
*              Do tests 28 and 29 (or +54)
*
               CALL slacpy( ' ', n, n, v, ldu, a, lda )
*
               CALL ssyt21( 1, uplo, n, 0, a, ldu, d1, d2, z, ldu, v,
     $                      ldu, tau, work, result( ntest ) )
*
               ntest = ntest + 2
               srnamt = 'SSYEVX'
               CALL ssyevx( 'N', 'A', uplo, n, a, ldu, vl, vu, il, iu,
     $                      abstol, m2, wa2, z, ldu, work, lwork, iwork,
     $                      iwork( 5*n+1 ), iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSYEVX(N,A,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     GO TO 680
                  END IF
               END IF
*
*              Do test 30 (or +54)
*
               temp1 = zero
               temp2 = zero
               DO 670 j = 1, n
                  temp1 = max( temp1, abs( wa1( j ) ), abs( wa2( j ) ) )
                  temp2 = max( temp2, abs( wa1( j )-wa2( j ) ) )
  670          CONTINUE
               result( ntest ) = temp2 / max( unfl,
     $                           ulp*max( temp1, temp2 ) )
*
  680          CONTINUE
*
               ntest = ntest + 1
               CALL slacpy( ' ', n, n, v, ldu, a, lda )
               srnamt = 'SSYEVX'
               CALL ssyevx( 'V', 'I', uplo, n, a, ldu, vl, vu, il, iu,
     $                      abstol, m2, wa2, z, ldu, work, lwork, iwork,
     $                      iwork( 5*n+1 ), iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSYEVX(V,I,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     result( ntest+1 ) = ulpinv
                     result( ntest+2 ) = ulpinv
                     GO TO 690
                  END IF
               END IF
*
*              Do tests 31 and 32 (or +54)
*
               CALL slacpy( ' ', n, n, v, ldu, a, lda )
*
               CALL ssyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
     $                      v, ldu, tau, work, result( ntest ) )
*
               ntest = ntest + 2
               CALL slacpy( ' ', n, n, v, ldu, a, lda )
               srnamt = 'SSYEVX'
               CALL ssyevx( 'N', 'I', uplo, n, a, ldu, vl, vu, il, iu,
     $                      abstol, m3, wa3, z, ldu, work, lwork, iwork,
     $                      iwork( 5*n+1 ), iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSYEVX(N,I,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     GO TO 690
                  END IF
               END IF
*
*              Do test 33 (or +54)
*
               temp1 = ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
               temp2 = ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
               result( ntest ) = ( temp1+temp2 ) /
     $                           max( unfl, ulp*temp3 )
  690          CONTINUE
*
               ntest = ntest + 1
               CALL slacpy( ' ', n, n, v, ldu, a, lda )
               srnamt = 'SSYEVX'
               CALL ssyevx( 'V', 'V', uplo, n, a, ldu, vl, vu, il, iu,
     $                      abstol, m2, wa2, z, ldu, work, lwork, iwork,
     $                      iwork( 5*n+1 ), iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSYEVX(V,V,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     result( ntest+1 ) = ulpinv
                     result( ntest+2 ) = ulpinv
                     GO TO 700
                  END IF
               END IF
*
*              Do tests 34 and 35 (or +54)
*
               CALL slacpy( ' ', n, n, v, ldu, a, lda )
*
               CALL ssyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
     $                      v, ldu, tau, work, result( ntest ) )
*
               ntest = ntest + 2
               CALL slacpy( ' ', n, n, v, ldu, a, lda )
               srnamt = 'SSYEVX'
               CALL ssyevx( 'N', 'V', uplo, n, a, ldu, vl, vu, il, iu,
     $                      abstol, m3, wa3, z, ldu, work, lwork, iwork,
     $                      iwork( 5*n+1 ), iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSYEVX(N,V,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     GO TO 700
                  END IF
               END IF
*
               IF( m3.EQ.0 .AND. n.GT.0 ) THEN
                  result( ntest ) = ulpinv
                  GO TO 700
               END IF
*
*              Do test 36 (or +54)
*
               temp1 = ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
               temp2 = ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
               IF( n.GT.0 ) THEN
                  temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
               ELSE
                  temp3 = zero
               END IF
               result( ntest ) = ( temp1+temp2 ) /
     $                           max( unfl, temp3*ulp )
*
  700          CONTINUE
*
*              5)      Call SSPEV and SSPEVX.
*
               CALL slacpy( ' ', n, n, v, ldu, a, lda )
*
*              Load array WORK with the upper or lower triangular
*              part of the matrix in packed form.
*
               IF( iuplo.EQ.1 ) THEN
                  indx = 1
                  DO 720 j = 1, n
                     DO 710 i = 1, j
                        work( indx ) = a( i, j )
                        indx = indx + 1
  710                CONTINUE
  720             CONTINUE
               ELSE
                  indx = 1
                  DO 740 j = 1, n
                     DO 730 i = j, n
                        work( indx ) = a( i, j )
                        indx = indx + 1
  730                CONTINUE
  740             CONTINUE
               END IF
*
               ntest = ntest + 1
               srnamt = 'SSPEV'
               CALL sspev( 'V', uplo, n, work, d1, z, ldu, v, iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSPEV(V,' // uplo // ')',
     $               iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     result( ntest+1 ) = ulpinv
                     result( ntest+2 ) = ulpinv
                     GO TO 800
                  END IF
               END IF
*
*              Do tests 37 and 38 (or +54)
*
               CALL ssyt21( 1, uplo, n, 0, a, lda, d1, d2, z, ldu, v,
     $                      ldu, tau, work, result( ntest ) )
*
               IF( iuplo.EQ.1 ) THEN
                  indx = 1
                  DO 760 j = 1, n
                     DO 750 i = 1, j
                        work( indx ) = a( i, j )
                        indx = indx + 1
  750                CONTINUE
  760             CONTINUE
               ELSE
                  indx = 1
                  DO 780 j = 1, n
                     DO 770 i = j, n
                        work( indx ) = a( i, j )
                        indx = indx + 1
  770                CONTINUE
  780             CONTINUE
               END IF
*
               ntest = ntest + 2
               srnamt = 'SSPEV'
               CALL sspev( 'N', uplo, n, work, d3, z, ldu, v, iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSPEV(N,' // uplo // ')',
     $               iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     GO TO 800
                  END IF
               END IF
*
*              Do test 39 (or +54)
*
               temp1 = zero
               temp2 = zero
               DO 790 j = 1, n
                  temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
                  temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
  790          CONTINUE
               result( ntest ) = temp2 / max( unfl,
     $                           ulp*max( temp1, temp2 ) )
*
*              Load array WORK with the upper or lower triangular part
*              of the matrix in packed form.
*
  800          CONTINUE
               IF( iuplo.EQ.1 ) THEN
                  indx = 1
                  DO 820 j = 1, n
                     DO 810 i = 1, j
                        work( indx ) = a( i, j )
                        indx = indx + 1
  810                CONTINUE
  820             CONTINUE
               ELSE
                  indx = 1
                  DO 840 j = 1, n
                     DO 830 i = j, n
                        work( indx ) = a( i, j )
                        indx = indx + 1
  830                CONTINUE
  840             CONTINUE
               END IF
*
               ntest = ntest + 1
*
               IF( n.GT.0 ) THEN
                  temp3 = max( abs( d1( 1 ) ), abs( d1( n ) ) )
                  IF( il.NE.1 ) THEN
                     vl = d1( il ) - max( half*( d1( il )-d1( il-1 ) ),
     $                    ten*ulp*temp3, ten*rtunfl )
                  ELSE IF( n.GT.0 ) THEN
                     vl = d1( 1 ) - max( half*( d1( n )-d1( 1 ) ),
     $                    ten*ulp*temp3, ten*rtunfl )
                  END IF
                  IF( iu.NE.n ) THEN
                     vu = d1( iu ) + max( half*( d1( iu+1 )-d1( iu ) ),
     $                    ten*ulp*temp3, ten*rtunfl )
                  ELSE IF( n.GT.0 ) THEN
                     vu = d1( n ) + max( half*( d1( n )-d1( 1 ) ),
     $                    ten*ulp*temp3, ten*rtunfl )
                  END IF
               ELSE
                  temp3 = zero
                  vl = zero
                  vu = one
               END IF
*
               srnamt = 'SSPEVX'
               CALL sspevx( 'V', 'A', uplo, n, work, vl, vu, il, iu,
     $                      abstol, m, wa1, z, ldu, v, iwork,
     $                      iwork( 5*n+1 ), iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSPEVX(V,A,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     result( ntest+1 ) = ulpinv
                     result( ntest+2 ) = ulpinv
                     GO TO 900
                  END IF
               END IF
*
*              Do tests 40 and 41 (or +54)
*
               CALL ssyt21( 1, uplo, n, 0, a, ldu, wa1, d2, z, ldu, v,
     $                      ldu, tau, work, result( ntest ) )
*
               ntest = ntest + 2
*
               IF( iuplo.EQ.1 ) THEN
                  indx = 1
                  DO 860 j = 1, n
                     DO 850 i = 1, j
                        work( indx ) = a( i, j )
                        indx = indx + 1
  850                CONTINUE
  860             CONTINUE
               ELSE
                  indx = 1
                  DO 880 j = 1, n
                     DO 870 i = j, n
                        work( indx ) = a( i, j )
                        indx = indx + 1
  870                CONTINUE
  880             CONTINUE
               END IF
*
               srnamt = 'SSPEVX'
               CALL sspevx( 'N', 'A', uplo, n, work, vl, vu, il, iu,
     $                      abstol, m2, wa2, z, ldu, v, iwork,
     $                      iwork( 5*n+1 ), iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSPEVX(N,A,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     GO TO 900
                  END IF
               END IF
*
*              Do test 42 (or +54)
*
               temp1 = zero
               temp2 = zero
               DO 890 j = 1, n
                  temp1 = max( temp1, abs( wa1( j ) ), abs( wa2( j ) ) )
                  temp2 = max( temp2, abs( wa1( j )-wa2( j ) ) )
  890          CONTINUE
               result( ntest ) = temp2 / max( unfl,
     $                           ulp*max( temp1, temp2 ) )
*
  900          CONTINUE
               IF( iuplo.EQ.1 ) THEN
                  indx = 1
                  DO 920 j = 1, n
                     DO 910 i = 1, j
                        work( indx ) = a( i, j )
                        indx = indx + 1
  910                CONTINUE
  920             CONTINUE
               ELSE
                  indx = 1
                  DO 940 j = 1, n
                     DO 930 i = j, n
                        work( indx ) = a( i, j )
                        indx = indx + 1
  930                CONTINUE
  940             CONTINUE
               END IF
*
               ntest = ntest + 1
*
               srnamt = 'SSPEVX'
               CALL sspevx( 'V', 'I', uplo, n, work, vl, vu, il, iu,
     $                      abstol, m2, wa2, z, ldu, v, iwork,
     $                      iwork( 5*n+1 ), iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSPEVX(V,I,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     result( ntest+1 ) = ulpinv
                     result( ntest+2 ) = ulpinv
                     GO TO 990
                  END IF
               END IF
*
*              Do tests 43 and 44 (or +54)
*
               CALL ssyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
     $                      v, ldu, tau, work, result( ntest ) )
*
               ntest = ntest + 2
*
               IF( iuplo.EQ.1 ) THEN
                  indx = 1
                  DO 960 j = 1, n
                     DO 950 i = 1, j
                        work( indx ) = a( i, j )
                        indx = indx + 1
  950                CONTINUE
  960             CONTINUE
               ELSE
                  indx = 1
                  DO 980 j = 1, n
                     DO 970 i = j, n
                        work( indx ) = a( i, j )
                        indx = indx + 1
  970                CONTINUE
  980             CONTINUE
               END IF
*
               srnamt = 'SSPEVX'
               CALL sspevx( 'N', 'I', uplo, n, work, vl, vu, il, iu,
     $                      abstol, m3, wa3, z, ldu, v, iwork,
     $                      iwork( 5*n+1 ), iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSPEVX(N,I,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     GO TO 990
                  END IF
               END IF
*
               IF( m3.EQ.0 .AND. n.GT.0 ) THEN
                  result( ntest ) = ulpinv
                  GO TO 990
               END IF
*
*              Do test 45 (or +54)
*
               temp1 = ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
               temp2 = ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
               IF( n.GT.0 ) THEN
                  temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
               ELSE
                  temp3 = zero
               END IF
               result( ntest ) = ( temp1+temp2 ) /
     $                           max( unfl, temp3*ulp )
*
  990          CONTINUE
               IF( iuplo.EQ.1 ) THEN
                  indx = 1
                  DO 1010 j = 1, n
                     DO 1000 i = 1, j
                        work( indx ) = a( i, j )
                        indx = indx + 1
 1000                CONTINUE
 1010             CONTINUE
               ELSE
                  indx = 1
                  DO 1030 j = 1, n
                     DO 1020 i = j, n
                        work( indx ) = a( i, j )
                        indx = indx + 1
 1020                CONTINUE
 1030             CONTINUE
               END IF
*
               ntest = ntest + 1
*
               srnamt = 'SSPEVX'
               CALL sspevx( 'V', 'V', uplo, n, work, vl, vu, il, iu,
     $                      abstol, m2, wa2, z, ldu, v, iwork,
     $                      iwork( 5*n+1 ), iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSPEVX(V,V,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     result( ntest+1 ) = ulpinv
                     result( ntest+2 ) = ulpinv
                     GO TO 1080
                  END IF
               END IF
*
*              Do tests 46 and 47 (or +54)
*
               CALL ssyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
     $                      v, ldu, tau, work, result( ntest ) )
*
               ntest = ntest + 2
*
               IF( iuplo.EQ.1 ) THEN
                  indx = 1
                  DO 1050 j = 1, n
                     DO 1040 i = 1, j
                        work( indx ) = a( i, j )
                        indx = indx + 1
 1040                CONTINUE
 1050             CONTINUE
               ELSE
                  indx = 1
                  DO 1070 j = 1, n
                     DO 1060 i = j, n
                        work( indx ) = a( i, j )
                        indx = indx + 1
 1060                CONTINUE
 1070             CONTINUE
               END IF
*
               srnamt = 'SSPEVX'
               CALL sspevx( 'N', 'V', uplo, n, work, vl, vu, il, iu,
     $                      abstol, m3, wa3, z, ldu, v, iwork,
     $                      iwork( 5*n+1 ), iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSPEVX(N,V,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     GO TO 1080
                  END IF
               END IF
*
               IF( m3.EQ.0 .AND. n.GT.0 ) THEN
                  result( ntest ) = ulpinv
                  GO TO 1080
               END IF
*
*              Do test 48 (or +54)
*
               temp1 = ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
               temp2 = ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
               IF( n.GT.0 ) THEN
                  temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
               ELSE
                  temp3 = zero
               END IF
               result( ntest ) = ( temp1+temp2 ) /
     $                           max( unfl, temp3*ulp )
*
 1080          CONTINUE
*
*              6)      Call SSBEV and SSBEVX.
*
               IF( jtype.LE.7 ) THEN
                  kd = 1
               ELSE IF( jtype.GE.8 .AND. jtype.LE.15 ) THEN
                  kd = max( n-1, 0 )
               ELSE
                  kd = ihbw
               END IF
*
*              Load array V with the upper or lower triangular part
*              of the matrix in band form.
*
               IF( iuplo.EQ.1 ) THEN
                  DO 1100 j = 1, n
                     DO 1090 i = max( 1, j-kd ), j
                        v( kd+1+i-j, j ) = a( i, j )
 1090                CONTINUE
 1100             CONTINUE
               ELSE
                  DO 1120 j = 1, n
                     DO 1110 i = j, min( n, j+kd )
                        v( 1+i-j, j ) = a( i, j )
 1110                CONTINUE
 1120             CONTINUE
               END IF
*
               ntest = ntest + 1
               srnamt = 'SSBEV'
               CALL ssbev( 'V', uplo, n, kd, v, ldu, d1, z, ldu, work,
     $                     iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSBEV(V,' // uplo // ')',
     $               iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     result( ntest+1 ) = ulpinv
                     result( ntest+2 ) = ulpinv
                     GO TO 1180
                  END IF
               END IF
*
*              Do tests 49 and 50 (or ... )
*
               CALL ssyt21( 1, uplo, n, 0, a, lda, d1, d2, z, ldu, v,
     $                      ldu, tau, work, result( ntest ) )
*
               IF( iuplo.EQ.1 ) THEN
                  DO 1140 j = 1, n
                     DO 1130 i = max( 1, j-kd ), j
                        v( kd+1+i-j, j ) = a( i, j )
 1130                CONTINUE
 1140             CONTINUE
               ELSE
                  DO 1160 j = 1, n
                     DO 1150 i = j, min( n, j+kd )
                        v( 1+i-j, j ) = a( i, j )
 1150                CONTINUE
 1160             CONTINUE
               END IF
*
               ntest = ntest + 2
               srnamt = 'SSBEV'
               CALL ssbev( 'N', uplo, n, kd, v, ldu, d3, z, ldu, work,
     $                     iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSBEV(N,' // uplo // ')',
     $               iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     GO TO 1180
                  END IF
               END IF
*
*              Do test 51 (or +54)
*
               temp1 = zero
               temp2 = zero
               DO 1170 j = 1, n
                  temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
                  temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
 1170          CONTINUE
               result( ntest ) = temp2 / max( unfl,
     $                           ulp*max( temp1, temp2 ) )
*
*              Load array V with the upper or lower triangular part
*              of the matrix in band form.
*
 1180          CONTINUE
               IF( iuplo.EQ.1 ) THEN
                  DO 1200 j = 1, n
                     DO 1190 i = max( 1, j-kd ), j
                        v( kd+1+i-j, j ) = a( i, j )
 1190                CONTINUE
 1200             CONTINUE
               ELSE
                  DO 1220 j = 1, n
                     DO 1210 i = j, min( n, j+kd )
                        v( 1+i-j, j ) = a( i, j )
 1210                CONTINUE
 1220             CONTINUE
               END IF
*
               ntest = ntest + 1
               srnamt = 'SSBEVX'
               CALL ssbevx( 'V', 'A', uplo, n, kd, v, ldu, u, ldu, vl,
     $                      vu, il, iu, abstol, m, wa2, z, ldu, work,
     $                      iwork, iwork( 5*n+1 ), iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSBEVX(V,A,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     result( ntest+1 ) = ulpinv
                     result( ntest+2 ) = ulpinv
                     GO TO 1280
                  END IF
               END IF
*
*              Do tests 52 and 53 (or +54)
*
               CALL ssyt21( 1, uplo, n, 0, a, ldu, wa2, d2, z, ldu, v,
     $                      ldu, tau, work, result( ntest ) )
*
               ntest = ntest + 2
*
               IF( iuplo.EQ.1 ) THEN
                  DO 1240 j = 1, n
                     DO 1230 i = max( 1, j-kd ), j
                        v( kd+1+i-j, j ) = a( i, j )
 1230                CONTINUE
 1240             CONTINUE
               ELSE
                  DO 1260 j = 1, n
                     DO 1250 i = j, min( n, j+kd )
                        v( 1+i-j, j ) = a( i, j )
 1250                CONTINUE
 1260             CONTINUE
               END IF
*
               srnamt = 'SSBEVX'
               CALL ssbevx( 'N', 'A', uplo, n, kd, v, ldu, u, ldu, vl,
     $                      vu, il, iu, abstol, m3, wa3, z, ldu, work,
     $                      iwork, iwork( 5*n+1 ), iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSBEVX(N,A,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     GO TO 1280
                  END IF
               END IF
*
*              Do test 54 (or +54)
*
               temp1 = zero
               temp2 = zero
               DO 1270 j = 1, n
                  temp1 = max( temp1, abs( wa2( j ) ), abs( wa3( j ) ) )
                  temp2 = max( temp2, abs( wa2( j )-wa3( j ) ) )
 1270          CONTINUE
               result( ntest ) = temp2 / max( unfl,
     $                           ulp*max( temp1, temp2 ) )
*
 1280          CONTINUE
               ntest = ntest + 1
               IF( iuplo.EQ.1 ) THEN
                  DO 1300 j = 1, n
                     DO 1290 i = max( 1, j-kd ), j
                        v( kd+1+i-j, j ) = a( i, j )
 1290                CONTINUE
 1300             CONTINUE
               ELSE
                  DO 1320 j = 1, n
                     DO 1310 i = j, min( n, j+kd )
                        v( 1+i-j, j ) = a( i, j )
 1310                CONTINUE
 1320             CONTINUE
               END IF
*
               srnamt = 'SSBEVX'
               CALL ssbevx( 'V', 'I', uplo, n, kd, v, ldu, u, ldu, vl,
     $                      vu, il, iu, abstol, m2, wa2, z, ldu, work,
     $                      iwork, iwork( 5*n+1 ), iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSBEVX(V,I,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     result( ntest+1 ) = ulpinv
                     result( ntest+2 ) = ulpinv
                     GO TO 1370
                  END IF
               END IF
*
*              Do tests 55 and 56 (or +54)
*
               CALL ssyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
     $                      v, ldu, tau, work, result( ntest ) )
*
               ntest = ntest + 2
*
               IF( iuplo.EQ.1 ) THEN
                  DO 1340 j = 1, n
                     DO 1330 i = max( 1, j-kd ), j
                        v( kd+1+i-j, j ) = a( i, j )
 1330                CONTINUE
 1340             CONTINUE
               ELSE
                  DO 1360 j = 1, n
                     DO 1350 i = j, min( n, j+kd )
                        v( 1+i-j, j ) = a( i, j )
 1350                CONTINUE
 1360             CONTINUE
               END IF
*
               srnamt = 'SSBEVX'
               CALL ssbevx( 'N', 'I', uplo, n, kd, v, ldu, u, ldu, vl,
     $                      vu, il, iu, abstol, m3, wa3, z, ldu, work,
     $                      iwork, iwork( 5*n+1 ), iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSBEVX(N,I,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     GO TO 1370
                  END IF
               END IF
*
*              Do test 57 (or +54)
*
               temp1 = ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
               temp2 = ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
               IF( n.GT.0 ) THEN
                  temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
               ELSE
                  temp3 = zero
               END IF
               result( ntest ) = ( temp1+temp2 ) /
     $                           max( unfl, temp3*ulp )
*
 1370          CONTINUE
               ntest = ntest + 1
               IF( iuplo.EQ.1 ) THEN
                  DO 1390 j = 1, n
                     DO 1380 i = max( 1, j-kd ), j
                        v( kd+1+i-j, j ) = a( i, j )
 1380                CONTINUE
 1390             CONTINUE
               ELSE
                  DO 1410 j = 1, n
                     DO 1400 i = j, min( n, j+kd )
                        v( 1+i-j, j ) = a( i, j )
 1400                CONTINUE
 1410             CONTINUE
               END IF
*
               srnamt = 'SSBEVX'
               CALL ssbevx( 'V', 'V', uplo, n, kd, v, ldu, u, ldu, vl,
     $                      vu, il, iu, abstol, m2, wa2, z, ldu, work,
     $                      iwork, iwork( 5*n+1 ), iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSBEVX(V,V,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     result( ntest+1 ) = ulpinv
                     result( ntest+2 ) = ulpinv
                     GO TO 1460
                  END IF
               END IF
*
*              Do tests 58 and 59 (or +54)
*
               CALL ssyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
     $                      v, ldu, tau, work, result( ntest ) )
*
               ntest = ntest + 2
*
               IF( iuplo.EQ.1 ) THEN
                  DO 1430 j = 1, n
                     DO 1420 i = max( 1, j-kd ), j
                        v( kd+1+i-j, j ) = a( i, j )
 1420                CONTINUE
 1430             CONTINUE
               ELSE
                  DO 1450 j = 1, n
                     DO 1440 i = j, min( n, j+kd )
                        v( 1+i-j, j ) = a( i, j )
 1440                CONTINUE
 1450             CONTINUE
               END IF
*
               srnamt = 'SSBEVX'
               CALL ssbevx( 'N', 'V', uplo, n, kd, v, ldu, u, ldu, vl,
     $                      vu, il, iu, abstol, m3, wa3, z, ldu, work,
     $                      iwork, iwork( 5*n+1 ), iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSBEVX(N,V,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     GO TO 1460
                  END IF
               END IF
*
               IF( m3.EQ.0 .AND. n.GT.0 ) THEN
                  result( ntest ) = ulpinv
                  GO TO 1460
               END IF
*
*              Do test 60 (or +54)
*
               temp1 = ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
               temp2 = ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
               IF( n.GT.0 ) THEN
                  temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
               ELSE
                  temp3 = zero
               END IF
               result( ntest ) = ( temp1+temp2 ) /
     $                           max( unfl, temp3*ulp )
*
 1460          CONTINUE
*
*              7)      Call SSYEVD
*
               CALL slacpy( ' ', n, n, a, lda, v, ldu )
*
               ntest = ntest + 1
               srnamt = 'SSYEVD'
               CALL ssyevd( 'V', uplo, n, a, ldu, d1, work, lwedc,
     $                      iwork, liwedc, iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSYEVD(V,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     result( ntest+1 ) = ulpinv
                     result( ntest+2 ) = ulpinv
                     GO TO 1480
                  END IF
               END IF
*
*              Do tests 61 and 62 (or +54)
*
               CALL ssyt21( 1, uplo, n, 0, v, ldu, d1, d2, a, ldu, z,
     $                      ldu, tau, work, result( ntest ) )
*
               CALL slacpy( ' ', n, n, v, ldu, a, lda )
*
               ntest = ntest + 2
               srnamt = 'SSYEVD'
               CALL ssyevd( 'N', uplo, n, a, ldu, d3, work, lwedc,
     $                      iwork, liwedc, iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSYEVD(N,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     GO TO 1480
                  END IF
               END IF
*
*              Do test 63 (or +54)
*
               temp1 = zero
               temp2 = zero
               DO 1470 j = 1, n
                  temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
                  temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
 1470          CONTINUE
               result( ntest ) = temp2 / max( unfl,
     $                           ulp*max( temp1, temp2 ) )
*
 1480          CONTINUE
*
*              8)      Call SSPEVD.
*
               CALL slacpy( ' ', n, n, v, ldu, a, lda )
*
*              Load array WORK with the upper or lower triangular
*              part of the matrix in packed form.
*
               IF( iuplo.EQ.1 ) THEN
                  indx = 1
                  DO 1500 j = 1, n
                     DO 1490 i = 1, j
                        work( indx ) = a( i, j )
                        indx = indx + 1
 1490                CONTINUE
 1500             CONTINUE
               ELSE
                  indx = 1
                  DO 1520 j = 1, n
                     DO 1510 i = j, n
                        work( indx ) = a( i, j )
                        indx = indx + 1
 1510                CONTINUE
 1520             CONTINUE
               END IF
*
               ntest = ntest + 1
               srnamt = 'SSPEVD'
               CALL sspevd( 'V', uplo, n, work, d1, z, ldu,
     $                      work( indx ), lwedc-indx+1, iwork, liwedc,
     $                      iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSPEVD(V,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     result( ntest+1 ) = ulpinv
                     result( ntest+2 ) = ulpinv
                     GO TO 1580
                  END IF
               END IF
*
*              Do tests 64 and 65 (or +54)
*
               CALL ssyt21( 1, uplo, n, 0, a, lda, d1, d2, z, ldu, v,
     $                      ldu, tau, work, result( ntest ) )
*
               IF( iuplo.EQ.1 ) THEN
                  indx = 1
                  DO 1540 j = 1, n
                     DO 1530 i = 1, j
*
                        work( indx ) = a( i, j )
                        indx = indx + 1
 1530                CONTINUE
 1540             CONTINUE
               ELSE
                  indx = 1
                  DO 1560 j = 1, n
                     DO 1550 i = j, n
                        work( indx ) = a( i, j )
                        indx = indx + 1
 1550                CONTINUE
 1560             CONTINUE
               END IF
*
               ntest = ntest + 2
               srnamt = 'SSPEVD'
               CALL sspevd( 'N', uplo, n, work, d3, z, ldu,
     $                      work( indx ), lwedc-indx+1, iwork, liwedc,
     $                      iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSPEVD(N,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     GO TO 1580
                  END IF
               END IF
*
*              Do test 66 (or +54)
*
               temp1 = zero
               temp2 = zero
               DO 1570 j = 1, n
                  temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
                  temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
 1570          CONTINUE
               result( ntest ) = temp2 / max( unfl,
     $                           ulp*max( temp1, temp2 ) )
 1580          CONTINUE
*
*              9)      Call SSBEVD.
*
               IF( jtype.LE.7 ) THEN
                  kd = 1
               ELSE IF( jtype.GE.8 .AND. jtype.LE.15 ) THEN
                  kd = max( n-1, 0 )
               ELSE
                  kd = ihbw
               END IF
*
*              Load array V with the upper or lower triangular part
*              of the matrix in band form.
*
               IF( iuplo.EQ.1 ) THEN
                  DO 1600 j = 1, n
                     DO 1590 i = max( 1, j-kd ), j
                        v( kd+1+i-j, j ) = a( i, j )
 1590                CONTINUE
 1600             CONTINUE
               ELSE
                  DO 1620 j = 1, n
                     DO 1610 i = j, min( n, j+kd )
                        v( 1+i-j, j ) = a( i, j )
 1610                CONTINUE
 1620             CONTINUE
               END IF
*
               ntest = ntest + 1
               srnamt = 'SSBEVD'
               CALL ssbevd( 'V', uplo, n, kd, v, ldu, d1, z, ldu, work,
     $                      lwedc, iwork, liwedc, iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSBEVD(V,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     result( ntest+1 ) = ulpinv
                     result( ntest+2 ) = ulpinv
                     GO TO 1680
                  END IF
               END IF
*
*              Do tests 67 and 68 (or +54)
*
               CALL ssyt21( 1, uplo, n, 0, a, lda, d1, d2, z, ldu, v,
     $                      ldu, tau, work, result( ntest ) )
*
               IF( iuplo.EQ.1 ) THEN
                  DO 1640 j = 1, n
                     DO 1630 i = max( 1, j-kd ), j
                        v( kd+1+i-j, j ) = a( i, j )
 1630                CONTINUE
 1640             CONTINUE
               ELSE
                  DO 1660 j = 1, n
                     DO 1650 i = j, min( n, j+kd )
                        v( 1+i-j, j ) = a( i, j )
 1650                CONTINUE
 1660             CONTINUE
               END IF
*
               ntest = ntest + 2
               srnamt = 'SSBEVD'
               CALL ssbevd( 'N', uplo, n, kd, v, ldu, d3, z, ldu, work,
     $                      lwedc, iwork, liwedc, iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSBEVD(N,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     GO TO 1680
                  END IF
               END IF
*
*              Do test 69 (or +54)
*
               temp1 = zero
               temp2 = zero
               DO 1670 j = 1, n
                  temp1 = max( temp1, abs( d1( j ) ), abs( d3( j ) ) )
                  temp2 = max( temp2, abs( d1( j )-d3( j ) ) )
 1670          CONTINUE
               result( ntest ) = temp2 / max( unfl,
     $                           ulp*max( temp1, temp2 ) )
*
 1680          CONTINUE
*
*
               CALL slacpy( ' ', n, n, a, lda, v, ldu )
               ntest = ntest + 1
               srnamt = 'SSYEVR'
               CALL ssyevr( 'V', 'A', uplo, n, a, ldu, vl, vu, il, iu,
     $                      abstol, m, wa1, z, ldu, iwork, work, lwork,
     $                      iwork(2*n+1), liwork-2*n, iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSYEVR(V,A,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     result( ntest+1 ) = ulpinv
                     result( ntest+2 ) = ulpinv
                     GO TO 1700
                  END IF
               END IF
*
*              Do tests 70 and 71 (or ... )
*
               CALL slacpy( ' ', n, n, v, ldu, a, lda )
*
               CALL ssyt21( 1, uplo, n, 0, a, ldu, wa1, d2, z, ldu, v,
     $                      ldu, tau, work, result( ntest ) )
*
               ntest = ntest + 2
               srnamt = 'SSYEVR'
               CALL ssyevr( 'N', 'A', uplo, n, a, ldu, vl, vu, il, iu,
     $                      abstol, m2, wa2, z, ldu, iwork, work, lwork,
     $                      iwork(2*n+1), liwork-2*n, iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSYEVR(N,A,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     GO TO 1700
                  END IF
               END IF
*
*              Do test 72 (or ... )
*
               temp1 = zero
               temp2 = zero
               DO 1690 j = 1, n
                  temp1 = max( temp1, abs( wa1( j ) ), abs( wa2( j ) ) )
                  temp2 = max( temp2, abs( wa1( j )-wa2( j ) ) )
 1690          CONTINUE
               result( ntest ) = temp2 / max( unfl,
     $                           ulp*max( temp1, temp2 ) )
*
 1700          CONTINUE
*
               ntest = ntest + 1
               CALL slacpy( ' ', n, n, v, ldu, a, lda )
               srnamt = 'SSYEVR'
               CALL ssyevr( 'V', 'I', uplo, n, a, ldu, vl, vu, il, iu,
     $                      abstol, m2, wa2, z, ldu, iwork, work, lwork,
     $                      iwork(2*n+1), liwork-2*n, iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSYEVR(V,I,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     result( ntest+1 ) = ulpinv
                     result( ntest+2 ) = ulpinv
                     GO TO 1710
                  END IF
               END IF
*
*              Do tests 73 and 74 (or +54)
*
               CALL slacpy( ' ', n, n, v, ldu, a, lda )
*
               CALL ssyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
     $                      v, ldu, tau, work, result( ntest ) )
*
               ntest = ntest + 2
               CALL slacpy( ' ', n, n, v, ldu, a, lda )
               srnamt = 'SSYEVR'
               CALL ssyevr( 'N', 'I', uplo, n, a, ldu, vl, vu, il, iu,
     $                      abstol, m3, wa3, z, ldu, iwork, work, lwork,
     $                      iwork(2*n+1), liwork-2*n, iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSYEVR(N,I,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     GO TO 1710
                  END IF
               END IF
*
*              Do test 75 (or +54)
*
               temp1 = ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
               temp2 = ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
               result( ntest ) = ( temp1+temp2 ) /
     $                           max( unfl, ulp*temp3 )
 1710          CONTINUE
*
               ntest = ntest + 1
               CALL slacpy( ' ', n, n, v, ldu, a, lda )
               srnamt = 'SSYEVR'
               CALL ssyevr( 'V', 'V', uplo, n, a, ldu, vl, vu, il, iu,
     $                      abstol, m2, wa2, z, ldu, iwork, work, lwork,
     $                      iwork(2*n+1), liwork-2*n, iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSYEVR(V,V,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     result( ntest+1 ) = ulpinv
                     result( ntest+2 ) = ulpinv
                     GO TO 1750
                  END IF
               END IF
*
*              Do tests 76 and 77 (or +54)
*
               CALL slacpy( ' ', n, n, v, ldu, a, lda )
*
               CALL ssyt22( 1, uplo, n, m2, 0, a, ldu, wa2, d2, z, ldu,
     $                      v, ldu, tau, work, result( ntest ) )
*
               ntest = ntest + 2
               CALL slacpy( ' ', n, n, v, ldu, a, lda )
               srnamt = 'SSYEVR'
               CALL ssyevr( 'N', 'V', uplo, n, a, ldu, vl, vu, il, iu,
     $                      abstol, m3, wa3, z, ldu, iwork, work, lwork,
     $                      iwork(2*n+1), liwork-2*n, iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nounit, fmt = 9999 )'SSYEVR(N,V,' // uplo //
     $               ')', iinfo, n, jtype, ioldsd
                  info = abs( iinfo )
                  IF( iinfo.LT.0 ) THEN
                     RETURN
                  ELSE
                     result( ntest ) = ulpinv
                     GO TO 1750
                  END IF
               END IF
*
               IF( m3.EQ.0 .AND. n.GT.0 ) THEN
                  result( ntest ) = ulpinv
                  GO TO 1750
               END IF
*
*              Do test 78 (or +54)
*
               temp1 = ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
               temp2 = ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
               IF( n.GT.0 ) THEN
                  temp3 = max( abs( wa1( 1 ) ), abs( wa1( n ) ) )
               ELSE
                  temp3 = zero
               END IF
               result( ntest ) = ( temp1+temp2 ) /
     $                           max( unfl, temp3*ulp )
*
               CALL slacpy( ' ', n, n, v, ldu, a, lda )
*
 1750       CONTINUE
*
 1720       CONTINUE
*
*           End of Loop -- Check for RESULT(j) > THRESH
*
            ntestt = ntestt + ntest
*
            CALL slafts( 'SST', n, n, jtype, ntest, result, ioldsd,
     $                   thresh, nounit, nerrs )
*
 1730    CONTINUE
 1740 CONTINUE
*
*     Summary
*
      CALL alasvm( 'SST', nounit, nerrs, ntestt, 0 )
*
 9999 FORMAT( ' SDRVST: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
     $      i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5, ')' )
*
      RETURN
*
*     End of SDRVST
*

Here is the call graph for this function:

Here is the caller graph for this function: