LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ schkst2stg()

subroutine schkst2stg ( 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( * )  AP,
real, dimension( * )  SD,
real, dimension( * )  SE,
real, dimension( * )  D1,
real, dimension( * )  D2,
real, dimension( * )  D3,
real, dimension( * )  D4,
real, dimension( * )  D5,
real, dimension( * )  WA1,
real, dimension( * )  WA2,
real, dimension( * )  WA3,
real, dimension( * )  WR,
real, dimension( ldu, * )  U,
integer  LDU,
real, dimension( ldu, * )  V,
real, dimension( * )  VP,
real, dimension( * )  TAU,
real, dimension( ldu, * )  Z,
real, dimension( * )  WORK,
integer  LWORK,
integer, dimension( * )  IWORK,
integer  LIWORK,
real, dimension( * )  RESULT,
integer  INFO 
)

SCHKST2STG

Purpose:
 SCHKST2STG  checks the symmetric eigenvalue problem routines
 using the 2-stage reduction techniques. Since the generation
 of Q or the vectors is not available in this release, we only 
 compare the eigenvalue resulting when using the 2-stage to the 
 one considered as reference using the standard 1-stage reduction
 SSYTRD. For that, we call the standard SSYTRD and compute D1 using 
 SSTEQR, then we call the 2-stage SSYTRD_2STAGE with Upper and Lower
 and we compute D2 and D3 using SSTEQR and then we replaced tests
 3 and 4 by tests 11 and 12. test 1 and 2 remain to verify that 
 the 1-stage results are OK and can be trusted.
 This testing routine will converge to the SCHKST in the next 
 release when vectors and generation of Q will be implemented.

    SSYTRD factors A as  U S U' , where ' means transpose,
    S is symmetric tridiagonal, and U is orthogonal.
    SSYTRD can use either just the lower or just the upper triangle
    of A; SCHKST2STG checks both cases.
    U is represented as a product of Householder
    transformations, whose vectors are stored in the first
    n-1 columns of V, and whose scale factors are in TAU.

    SSPTRD does the same as SSYTRD, except that A and V are stored
    in "packed" format.

    SORGTR constructs the matrix U from the contents of V and TAU.

    SOPGTR constructs the matrix U from the contents of VP and TAU.

    SSTEQR factors S as  Z D1 Z' , where Z is the orthogonal
    matrix of eigenvectors and D1 is a diagonal matrix with
    the eigenvalues on the diagonal.  D2 is the matrix of
    eigenvalues computed when Z is not computed.

    SSTERF computes D3, the matrix of eigenvalues, by the
    PWK method, which does not yield eigenvectors.

    SPTEQR factors S as  Z4 D4 Z4' , for a
    symmetric positive definite tridiagonal matrix.
    D5 is the matrix of eigenvalues computed when Z is not
    computed.

    SSTEBZ computes selected eigenvalues.  WA1, WA2, and
    WA3 will denote eigenvalues computed to high
    absolute accuracy, with different range options.
    WR will denote eigenvalues computed to high relative
    accuracy.

    SSTEIN computes Y, the eigenvectors of S, given the
    eigenvalues.

    SSTEDC factors S as Z D1 Z' , where Z is the orthogonal
    matrix of eigenvectors and D1 is a diagonal matrix with
    the eigenvalues on the diagonal ('I' option). It may also
    update an input orthogonal matrix, usually the output
    from SSYTRD/SORGTR or SSPTRD/SOPGTR ('V' option). It may
    also just compute eigenvalues ('N' option).

    SSTEMR factors S as Z D1 Z' , where Z is the orthogonal
    matrix of eigenvectors and D1 is a diagonal matrix with
    the eigenvalues on the diagonal ('I' option).  SSTEMR
    uses the Relatively Robust Representation whenever possible.

 When SCHKST2STG is called, a number of matrix "sizes" ("n's") and a
 number of matrix "types" are specified.  For each size ("n")
 and each type of matrix, one matrix will be generated and used
 to test the symmetric eigenroutines.  For each matrix, a number
 of tests will be performed:

 (1)     | A - V S V' | / ( |A| n ulp ) SSYTRD( UPLO='U', ... )

 (2)     | I - UV' | / ( n ulp )        SORGTR( UPLO='U', ... )

 (3)     | A - V S V' | / ( |A| n ulp ) SSYTRD( UPLO='L', ... )
         replaced by | D1 - D2 | / ( |D1| ulp ) where D1 is the 
         eigenvalue matrix computed using S and D2 is the 
         eigenvalue matrix computed using S_2stage the output of
         SSYTRD_2STAGE("N", "U",....). D1 and D2 are computed 
         via SSTEQR('N',...)  

 (4)     | I - UV' | / ( n ulp )        SORGTR( UPLO='L', ... )
         replaced by | D1 - D3 | / ( |D1| ulp ) where D1 is the 
         eigenvalue matrix computed using S and D3 is the 
         eigenvalue matrix computed using S_2stage the output of
         SSYTRD_2STAGE("N", "L",....). D1 and D3 are computed 
         via SSTEQR('N',...)  

 (5-8)   Same as 1-4, but for SSPTRD and SOPGTR.

 (9)     | S - Z D Z' | / ( |S| n ulp ) SSTEQR('V',...)

 (10)    | I - ZZ' | / ( n ulp )        SSTEQR('V',...)

 (11)    | D1 - D2 | / ( |D1| ulp )        SSTEQR('N',...)

 (12)    | D1 - D3 | / ( |D1| ulp )        SSTERF

 (13)    0 if the true eigenvalues (computed by sturm count)
         of S are within THRESH of
         those in D1.  2*THRESH if they are not.  (Tested using
         SSTECH)

 For S positive definite,

 (14)    | S - Z4 D4 Z4' | / ( |S| n ulp ) SPTEQR('V',...)

 (15)    | I - Z4 Z4' | / ( n ulp )        SPTEQR('V',...)

 (16)    | D4 - D5 | / ( 100 |D4| ulp )       SPTEQR('N',...)

 When S is also diagonally dominant by the factor gamma < 1,

 (17)    max | D4(i) - WR(i) | / ( |D4(i)| omega ) ,
          i
         omega = 2 (2n-1) ULP (1 + 8 gamma**2) / (1 - gamma)**4
                                              SSTEBZ( 'A', 'E', ...)

 (18)    | WA1 - D3 | / ( |D3| ulp )          SSTEBZ( 'A', 'E', ...)

 (19)    ( max { min | WA2(i)-WA3(j) | } +
            i     j
           max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
            i     j
                                              SSTEBZ( 'I', 'E', ...)

 (20)    | S - Y WA1 Y' | / ( |S| n ulp )  SSTEBZ, SSTEIN

 (21)    | I - Y Y' | / ( n ulp )          SSTEBZ, SSTEIN

 (22)    | S - Z D Z' | / ( |S| n ulp )    SSTEDC('I')

 (23)    | I - ZZ' | / ( n ulp )           SSTEDC('I')

 (24)    | S - Z D Z' | / ( |S| n ulp )    SSTEDC('V')

 (25)    | I - ZZ' | / ( n ulp )           SSTEDC('V')

 (26)    | D1 - D2 | / ( |D1| ulp )           SSTEDC('V') and
                                              SSTEDC('N')

 Test 27 is disabled at the moment because SSTEMR does not
 guarantee high relatvie accuracy.

 (27)    max | D6(i) - WR(i) | / ( |D6(i)| omega ) ,
          i
         omega = 2 (2n-1) ULP (1 + 8 gamma**2) / (1 - gamma)**4
                                              SSTEMR('V', 'A')

 (28)    max | D6(i) - WR(i) | / ( |D6(i)| omega ) ,
          i
         omega = 2 (2n-1) ULP (1 + 8 gamma**2) / (1 - gamma)**4
                                              SSTEMR('V', 'I')

 Tests 29 through 34 are disable at present because SSTEMR
 does not handle partial spectrum requests.

 (29)    | S - Z D Z' | / ( |S| n ulp )    SSTEMR('V', 'I')

 (30)    | I - ZZ' | / ( n ulp )           SSTEMR('V', 'I')

 (31)    ( max { min | WA2(i)-WA3(j) | } +
            i     j
           max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
            i     j
         SSTEMR('N', 'I') vs. SSTEMR('V', 'I')

 (32)    | S - Z D Z' | / ( |S| n ulp )    SSTEMR('V', 'V')

 (33)    | I - ZZ' | / ( n ulp )           SSTEMR('V', 'V')

 (34)    ( max { min | WA2(i)-WA3(j) | } +
            i     j
           max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
            i     j
         SSTEMR('N', 'V') vs. SSTEMR('V', 'V')

 (35)    | S - Z D Z' | / ( |S| n ulp )    SSTEMR('V', 'A')

 (36)    | I - ZZ' | / ( n ulp )           SSTEMR('V', 'A')

 (37)    ( max { min | WA2(i)-WA3(j) | } +
            i     j
           max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
            i     j
         SSTEMR('N', 'A') vs. SSTEMR('V', 'A')

 The "sizes" are specified by an array NN(1:NSIZES); the value of
 each element NN(j) specifies one size.
 The "types" are specified by a logical array DOTYPE( 1:NTYPES );
 if DOTYPE(j) is .TRUE., then matrix type "j" 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 entries
      1, ..., ULP  and random signs.
      (ULP = (first number larger than 1) - 1 )
 (4)  A diagonal matrix with geometrically spaced entries
      1, ..., ULP  and random signs.
 (5)  A diagonal matrix with "clustered" entries 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 "clustered" 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) Same as (8), but diagonal elements are all positive.
 (17) Same as (9), but diagonal elements are all positive.
 (18) Same as (10), but diagonal elements are all positive.
 (19) Same as (16), but multiplied by SQRT( overflow threshold )
 (20) Same as (16), but multiplied by SQRT( underflow threshold )
 (21) A diagonally dominant tridiagonal matrix with geometrically
      spaced diagonal entries 1, ..., ULP.
Parameters
[in]NSIZES
          NSIZES is INTEGER
          The number of sizes of matrices to use.  If it is zero,
          SCHKST2STG does nothing.  It must be at least zero.
[in]NN
          NN is 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.
[in]NTYPES
          NTYPES is INTEGER
          The number of elements in DOTYPE.   If it is zero, SCHKST2STG
          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. .
[in]DOTYPE
          DOTYPE is 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.
[in,out]ISEED
          ISEED is 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 SCHKST2STG to continue the same random number
          sequence.
[in]THRESH
          THRESH is REAL
          A test will count as "failed" if the "error", 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.
[in]NOUNIT
          NOUNIT is INTEGER
          The FORTRAN unit number for printing out error messages
          (e.g., if a routine returns IINFO not equal to 0.)
[in,out]A
          A is REAL array of
                                  dimension ( LDA , max(NN) )
          Used to hold the matrix whose eigenvalues are to be
          computed.  On exit, A contains the last matrix actually
          used.
[in]LDA
          LDA is INTEGER
          The leading dimension of A.  It must be at
          least 1 and at least max( NN ).
[out]AP
          AP is REAL array of
                      dimension( max(NN)*max(NN+1)/2 )
          The matrix A stored in packed format.
[out]SD
          SD is REAL array of
                             dimension( max(NN) )
          The diagonal of the tridiagonal matrix computed by SSYTRD.
          On exit, SD and SE contain the tridiagonal form of the
          matrix in A.
[out]SE
          SE is REAL array of
                             dimension( max(NN) )
          The off-diagonal of the tridiagonal matrix computed by
          SSYTRD.  On exit, SD and SE contain the tridiagonal form of
          the matrix in A.
[out]D1
          D1 is REAL array of
                             dimension( max(NN) )
          The eigenvalues of A, as computed by SSTEQR simlutaneously
          with Z.  On exit, the eigenvalues in D1 correspond with the
          matrix in A.
[out]D2
          D2 is REAL array of
                             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.
[out]D3
          D3 is REAL array of
                             dimension( max(NN) )
          The eigenvalues of A, as computed by SSTERF.  On exit, the
          eigenvalues in D3 correspond with the matrix in A.
[out]D4
          D4 is REAL array of
                             dimension( max(NN) )
          The eigenvalues of A, as computed by SPTEQR(V).
          SPTEQR factors S as  Z4 D4 Z4*
          On exit, the eigenvalues in D4 correspond with the matrix in A.
[out]D5
          D5 is REAL array of
                             dimension( max(NN) )
          The eigenvalues of A, as computed by SPTEQR(N)
          when Z is not computed. On exit, the
          eigenvalues in D4 correspond with the matrix in A.
[out]WA1
          WA1 is REAL array of
                             dimension( max(NN) )
          All eigenvalues of A, computed to high
          absolute accuracy, with different range options.
          as computed by SSTEBZ.
[out]WA2
          WA2 is REAL array of
                             dimension( max(NN) )
          Selected eigenvalues of A, computed to high
          absolute accuracy, with different range options.
          as computed by SSTEBZ.
          Choose random values for IL and IU, and ask for the
          IL-th through IU-th eigenvalues.
[out]WA3
          WA3 is REAL array of
                             dimension( max(NN) )
          Selected eigenvalues of A, computed to high
          absolute accuracy, with different range options.
          as computed by SSTEBZ.
          Determine the values VL and VU of the IL-th and IU-th
          eigenvalues and ask for all eigenvalues in this range.
[out]WR
          WR is REAL array of
                             dimension( max(NN) )
          All eigenvalues of A, computed to high
          absolute accuracy, with different options.
          as computed by SSTEBZ.
[out]U
          U is REAL array of
                             dimension( LDU, max(NN) ).
          The orthogonal matrix computed by SSYTRD + SORGTR.
[in]LDU
          LDU is INTEGER
          The leading dimension of U, Z, and V.  It must be at least 1
          and at least max( NN ).
[out]V
          V is REAL array of
                             dimension( LDU, max(NN) ).
          The Housholder vectors computed by SSYTRD in reducing A to
          tridiagonal form.  The vectors computed with UPLO='U' are
          in the upper triangle, and the vectors computed with UPLO='L'
          are in the lower triangle.  (As described in SSYTRD, the
          sub- and superdiagonal are not set to 1, although the
          true Householder vector has a 1 in that position.  The
          routines that use V, such as SORGTR, set those entries to
          1 before using them, and then restore them later.)
[out]VP
          VP is REAL array of
                      dimension( max(NN)*max(NN+1)/2 )
          The matrix V stored in packed format.
[out]TAU
          TAU is REAL array of
                             dimension( max(NN) )
          The Householder factors computed by SSYTRD in reducing A
          to tridiagonal form.
[out]Z
          Z is REAL array of
                             dimension( LDU, max(NN) ).
          The orthogonal matrix of eigenvectors computed by SSTEQR,
          SPTEQR, and SSTEIN.
[out]WORK
          WORK is REAL array of
                      dimension( LWORK )
[in]LWORK
          LWORK is INTEGER
          The number of entries in WORK.  This must be at least
          1 + 4 * Nmax + 2 * Nmax * lg Nmax + 3 * Nmax**2
          where Nmax = max( NN(j), 2 ) and lg = log base 2.
[out]IWORK
          IWORK is INTEGER array,
          Workspace.
[out]LIWORK
          LIWORK is INTEGER
          The number of entries in IWORK.  This must be at least
                  6 + 6*Nmax + 5 * Nmax * lg Nmax
          where Nmax = max( NN(j), 2 ) and lg = log base 2.
[out]RESULT
          RESULT is REAL array, dimension (26)
          The values computed by the tests described above.
          The values are currently limited to 1/ulp, to avoid
          overflow.
[out]INFO
          INFO is 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) ).
          -23: LDU < 1 or LDU < NMAX.
          -29: LWORK too small.
          If  SLATMR, SLATMS, SSYTRD, SORGTR, SSTEQR, SSTERF,
              or SORMC2 returns an error code, the
              absolute value of it is returned.

-----------------------------------------------------------------------

       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.
       NBLOCK          Blocksize as returned by ENVIR.
       NMAX            Largest value in NN.
       NMATS           The number of matrices generated so far.
       NERRS           The number of tests which have exceeded THRESH
                       so far.
       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 "j".
       KMODE(j)        The MODE value to be passed to the matrix
                       generator for type "j".
       KMAGN(j)        The order of magnitude ( O(1),
                       O(overflow^(1/2) ), O(underflow^(1/2) )
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 608 of file schkst2stg.f.

612 *
613 * -- LAPACK test routine --
614 * -- LAPACK is a software package provided by Univ. of Tennessee, --
615 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
616 *
617 * .. Scalar Arguments ..
618  INTEGER INFO, LDA, LDU, LIWORK, LWORK, NOUNIT, NSIZES,
619  $ NTYPES
620  REAL THRESH
621 * ..
622 * .. Array Arguments ..
623  LOGICAL DOTYPE( * )
624  INTEGER ISEED( 4 ), IWORK( * ), NN( * )
625  REAL A( LDA, * ), AP( * ), D1( * ), D2( * ),
626  $ D3( * ), D4( * ), D5( * ), RESULT( * ),
627  $ SD( * ), SE( * ), TAU( * ), U( LDU, * ),
628  $ V( LDU, * ), VP( * ), WA1( * ), WA2( * ),
629  $ WA3( * ), WORK( * ), WR( * ), Z( LDU, * )
630 * ..
631 *
632 * =====================================================================
633 *
634 * .. Parameters ..
635  REAL ZERO, ONE, TWO, EIGHT, TEN, HUN
636  parameter( zero = 0.0e0, one = 1.0e0, two = 2.0e0,
637  $ eight = 8.0e0, ten = 10.0e0, hun = 100.0e0 )
638  REAL HALF
639  parameter( half = one / two )
640  INTEGER MAXTYP
641  parameter( maxtyp = 21 )
642  LOGICAL SRANGE
643  parameter( srange = .false. )
644  LOGICAL SREL
645  parameter( srel = .false. )
646 * ..
647 * .. Local Scalars ..
648  LOGICAL BADNN, TRYRAC
649  INTEGER I, IINFO, IL, IMODE, ITEMP, ITYPE, IU, J, JC,
650  $ JR, JSIZE, JTYPE, LGN, LIWEDC, LOG2UI, LWEDC,
651  $ M, M2, M3, MTYPES, N, NAP, NBLOCK, NERRS,
652  $ NMATS, NMAX, NSPLIT, NTEST, NTESTT, LH, LW
653  REAL ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
654  $ RTUNFL, TEMP1, TEMP2, TEMP3, TEMP4, ULP,
655  $ ULPINV, UNFL, VL, VU
656 * ..
657 * .. Local Arrays ..
658  INTEGER IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
659  $ KMAGN( MAXTYP ), KMODE( MAXTYP ),
660  $ KTYPE( MAXTYP )
661  REAL DUMMA( 1 )
662 * ..
663 * .. External Functions ..
664  INTEGER ILAENV
665  REAL SLAMCH, SLARND, SSXT1
666  EXTERNAL ilaenv, slamch, slarnd, ssxt1
667 * ..
668 * .. External Subroutines ..
669  EXTERNAL scopy, slabad, slacpy, slaset, slasum, slatmr,
673  $ ssytrd_2stage
674 * ..
675 * .. Intrinsic Functions ..
676  INTRINSIC abs, real, int, log, max, min, sqrt
677 * ..
678 * .. Data statements ..
679  DATA ktype / 1, 2, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 8,
680  $ 8, 8, 9, 9, 9, 9, 9, 10 /
681  DATA kmagn / 1, 1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
682  $ 2, 3, 1, 1, 1, 2, 3, 1 /
683  DATA kmode / 0, 0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
684  $ 0, 0, 4, 3, 1, 4, 4, 3 /
685 * ..
686 * .. Executable Statements ..
687 *
688 * Keep ftnchek happy
689  idumma( 1 ) = 1
690 *
691 * Check for errors
692 *
693  ntestt = 0
694  info = 0
695 *
696 * Important constants
697 *
698  badnn = .false.
699  tryrac = .true.
700  nmax = 1
701  DO 10 j = 1, nsizes
702  nmax = max( nmax, nn( j ) )
703  IF( nn( j ).LT.0 )
704  $ badnn = .true.
705  10 CONTINUE
706 *
707  nblock = ilaenv( 1, 'SSYTRD', 'L', nmax, -1, -1, -1 )
708  nblock = min( nmax, max( 1, nblock ) )
709 *
710 * Check for errors
711 *
712  IF( nsizes.LT.0 ) THEN
713  info = -1
714  ELSE IF( badnn ) THEN
715  info = -2
716  ELSE IF( ntypes.LT.0 ) THEN
717  info = -3
718  ELSE IF( lda.LT.nmax ) THEN
719  info = -9
720  ELSE IF( ldu.LT.nmax ) THEN
721  info = -23
722  ELSE IF( 2*max( 2, nmax )**2.GT.lwork ) THEN
723  info = -29
724  END IF
725 *
726  IF( info.NE.0 ) THEN
727  CALL xerbla( 'SCHKST2STG', -info )
728  RETURN
729  END IF
730 *
731 * Quick return if possible
732 *
733  IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
734  $ RETURN
735 *
736 * More Important constants
737 *
738  unfl = slamch( 'Safe minimum' )
739  ovfl = one / unfl
740  CALL slabad( unfl, ovfl )
741  ulp = slamch( 'Epsilon' )*slamch( 'Base' )
742  ulpinv = one / ulp
743  log2ui = int( log( ulpinv ) / log( two ) )
744  rtunfl = sqrt( unfl )
745  rtovfl = sqrt( ovfl )
746 *
747 * Loop over sizes, types
748 *
749  DO 20 i = 1, 4
750  iseed2( i ) = iseed( i )
751  20 CONTINUE
752  nerrs = 0
753  nmats = 0
754 *
755  DO 310 jsize = 1, nsizes
756  n = nn( jsize )
757  IF( n.GT.0 ) THEN
758  lgn = int( log( real( n ) ) / log( two ) )
759  IF( 2**lgn.LT.n )
760  $ lgn = lgn + 1
761  IF( 2**lgn.LT.n )
762  $ lgn = lgn + 1
763  lwedc = 1 + 4*n + 2*n*lgn + 4*n**2
764  liwedc = 6 + 6*n + 5*n*lgn
765  ELSE
766  lwedc = 8
767  liwedc = 12
768  END IF
769  nap = ( n*( n+1 ) ) / 2
770  aninv = one / real( max( 1, n ) )
771 *
772  IF( nsizes.NE.1 ) THEN
773  mtypes = min( maxtyp, ntypes )
774  ELSE
775  mtypes = min( maxtyp+1, ntypes )
776  END IF
777 *
778  DO 300 jtype = 1, mtypes
779  IF( .NOT.dotype( jtype ) )
780  $ GO TO 300
781  nmats = nmats + 1
782  ntest = 0
783 *
784  DO 30 j = 1, 4
785  ioldsd( j ) = iseed( j )
786  30 CONTINUE
787 *
788 * Compute "A"
789 *
790 * Control parameters:
791 *
792 * KMAGN KMODE KTYPE
793 * =1 O(1) clustered 1 zero
794 * =2 large clustered 2 identity
795 * =3 small exponential (none)
796 * =4 arithmetic diagonal, (w/ eigenvalues)
797 * =5 random log symmetric, w/ eigenvalues
798 * =6 random (none)
799 * =7 random diagonal
800 * =8 random symmetric
801 * =9 positive definite
802 * =10 diagonally dominant tridiagonal
803 *
804  IF( mtypes.GT.maxtyp )
805  $ GO TO 100
806 *
807  itype = ktype( jtype )
808  imode = kmode( jtype )
809 *
810 * Compute norm
811 *
812  GO TO ( 40, 50, 60 )kmagn( jtype )
813 *
814  40 CONTINUE
815  anorm = one
816  GO TO 70
817 *
818  50 CONTINUE
819  anorm = ( rtovfl*ulp )*aninv
820  GO TO 70
821 *
822  60 CONTINUE
823  anorm = rtunfl*n*ulpinv
824  GO TO 70
825 *
826  70 CONTINUE
827 *
828  CALL slaset( 'Full', lda, n, zero, zero, a, lda )
829  iinfo = 0
830  IF( jtype.LE.15 ) THEN
831  cond = ulpinv
832  ELSE
833  cond = ulpinv*aninv / ten
834  END IF
835 *
836 * Special Matrices -- Identity & Jordan block
837 *
838 * Zero
839 *
840  IF( itype.EQ.1 ) THEN
841  iinfo = 0
842 *
843  ELSE IF( itype.EQ.2 ) THEN
844 *
845 * Identity
846 *
847  DO 80 jc = 1, n
848  a( jc, jc ) = anorm
849  80 CONTINUE
850 *
851  ELSE IF( itype.EQ.4 ) THEN
852 *
853 * Diagonal Matrix, [Eigen]values Specified
854 *
855  CALL slatms( n, n, 'S', iseed, 'S', work, imode, cond,
856  $ anorm, 0, 0, 'N', a, lda, work( n+1 ),
857  $ iinfo )
858 *
859 *
860  ELSE IF( itype.EQ.5 ) THEN
861 *
862 * Symmetric, eigenvalues specified
863 *
864  CALL slatms( n, n, 'S', iseed, 'S', work, imode, cond,
865  $ anorm, n, n, 'N', a, lda, work( n+1 ),
866  $ iinfo )
867 *
868  ELSE IF( itype.EQ.7 ) THEN
869 *
870 * Diagonal, random eigenvalues
871 *
872  CALL slatmr( n, n, 'S', iseed, 'S', work, 6, one, one,
873  $ 'T', 'N', work( n+1 ), 1, one,
874  $ work( 2*n+1 ), 1, one, 'N', idumma, 0, 0,
875  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
876 *
877  ELSE IF( itype.EQ.8 ) THEN
878 *
879 * Symmetric, random eigenvalues
880 *
881  CALL slatmr( n, n, 'S', iseed, 'S', work, 6, one, one,
882  $ 'T', 'N', work( n+1 ), 1, one,
883  $ work( 2*n+1 ), 1, one, 'N', idumma, n, n,
884  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
885 *
886  ELSE IF( itype.EQ.9 ) THEN
887 *
888 * Positive definite, eigenvalues specified.
889 *
890  CALL slatms( n, n, 'S', iseed, 'P', work, imode, cond,
891  $ anorm, n, n, 'N', a, lda, work( n+1 ),
892  $ iinfo )
893 *
894  ELSE IF( itype.EQ.10 ) THEN
895 *
896 * Positive definite tridiagonal, eigenvalues specified.
897 *
898  CALL slatms( n, n, 'S', iseed, 'P', work, imode, cond,
899  $ anorm, 1, 1, 'N', a, lda, work( n+1 ),
900  $ iinfo )
901  DO 90 i = 2, n
902  temp1 = abs( a( i-1, i ) ) /
903  $ sqrt( abs( a( i-1, i-1 )*a( i, i ) ) )
904  IF( temp1.GT.half ) THEN
905  a( i-1, i ) = half*sqrt( abs( a( i-1, i-1 )*a( i,
906  $ i ) ) )
907  a( i, i-1 ) = a( i-1, i )
908  END IF
909  90 CONTINUE
910 *
911  ELSE
912 *
913  iinfo = 1
914  END IF
915 *
916  IF( iinfo.NE.0 ) THEN
917  WRITE( nounit, fmt = 9999 )'Generator', iinfo, n, jtype,
918  $ ioldsd
919  info = abs( iinfo )
920  RETURN
921  END IF
922 *
923  100 CONTINUE
924 *
925 * Call SSYTRD and SORGTR to compute S and U from
926 * upper triangle.
927 *
928  CALL slacpy( 'U', n, n, a, lda, v, ldu )
929 *
930  ntest = 1
931  CALL ssytrd( 'U', n, v, ldu, sd, se, tau, work, lwork,
932  $ iinfo )
933 *
934  IF( iinfo.NE.0 ) THEN
935  WRITE( nounit, fmt = 9999 )'SSYTRD(U)', iinfo, n, jtype,
936  $ ioldsd
937  info = abs( iinfo )
938  IF( iinfo.LT.0 ) THEN
939  RETURN
940  ELSE
941  result( 1 ) = ulpinv
942  GO TO 280
943  END IF
944  END IF
945 *
946  CALL slacpy( 'U', n, n, v, ldu, u, ldu )
947 *
948  ntest = 2
949  CALL sorgtr( 'U', n, u, ldu, tau, work, lwork, iinfo )
950  IF( iinfo.NE.0 ) THEN
951  WRITE( nounit, fmt = 9999 )'SORGTR(U)', iinfo, n, jtype,
952  $ ioldsd
953  info = abs( iinfo )
954  IF( iinfo.LT.0 ) THEN
955  RETURN
956  ELSE
957  result( 2 ) = ulpinv
958  GO TO 280
959  END IF
960  END IF
961 *
962 * Do tests 1 and 2
963 *
964  CALL ssyt21( 2, 'Upper', n, 1, a, lda, sd, se, u, ldu, v,
965  $ ldu, tau, work, result( 1 ) )
966  CALL ssyt21( 3, 'Upper', n, 1, a, lda, sd, se, u, ldu, v,
967  $ ldu, tau, work, result( 2 ) )
968 *
969 * Compute D1 the eigenvalues resulting from the tridiagonal
970 * form using the standard 1-stage algorithm and use it as a
971 * reference to compare with the 2-stage technique
972 *
973 * Compute D1 from the 1-stage and used as reference for the
974 * 2-stage
975 *
976  CALL scopy( n, sd, 1, d1, 1 )
977  IF( n.GT.0 )
978  $ CALL scopy( n-1, se, 1, work, 1 )
979 *
980  CALL ssteqr( 'N', n, d1, work, work( n+1 ), ldu,
981  $ work( n+1 ), iinfo )
982  IF( iinfo.NE.0 ) THEN
983  WRITE( nounit, fmt = 9999 )'SSTEQR(N)', iinfo, n, jtype,
984  $ ioldsd
985  info = abs( iinfo )
986  IF( iinfo.LT.0 ) THEN
987  RETURN
988  ELSE
989  result( 3 ) = ulpinv
990  GO TO 280
991  END IF
992  END IF
993 *
994 * 2-STAGE TRD Upper case is used to compute D2.
995 * Note to set SD and SE to zero to be sure not reusing
996 * the one from above. Compare it with D1 computed
997 * using the 1-stage.
998 *
999  CALL slaset( 'Full', n, 1, zero, zero, sd, n )
1000  CALL slaset( 'Full', n, 1, zero, zero, se, n )
1001  CALL slacpy( "U", n, n, a, lda, v, ldu )
1002  lh = max(1, 4*n)
1003  lw = lwork - lh
1004  CALL ssytrd_2stage( 'N', "U", n, v, ldu, sd, se, tau,
1005  $ work, lh, work( lh+1 ), lw, iinfo )
1006 *
1007 * Compute D2 from the 2-stage Upper case
1008 *
1009  CALL scopy( n, sd, 1, d2, 1 )
1010  IF( n.GT.0 )
1011  $ CALL scopy( n-1, se, 1, work, 1 )
1012 *
1013  CALL ssteqr( 'N', n, d2, work, work( n+1 ), ldu,
1014  $ work( n+1 ), iinfo )
1015  IF( iinfo.NE.0 ) THEN
1016  WRITE( nounit, fmt = 9999 )'SSTEQR(N)', iinfo, n, jtype,
1017  $ ioldsd
1018  info = abs( iinfo )
1019  IF( iinfo.LT.0 ) THEN
1020  RETURN
1021  ELSE
1022  result( 3 ) = ulpinv
1023  GO TO 280
1024  END IF
1025  END IF
1026 *
1027 * 2-STAGE TRD Lower case is used to compute D3.
1028 * Note to set SD and SE to zero to be sure not reusing
1029 * the one from above. Compare it with D1 computed
1030 * using the 1-stage.
1031 *
1032  CALL slaset( 'Full', n, 1, zero, zero, sd, n )
1033  CALL slaset( 'Full', n, 1, zero, zero, se, n )
1034  CALL slacpy( "L", n, n, a, lda, v, ldu )
1035  CALL ssytrd_2stage( 'N', "L", n, v, ldu, sd, se, tau,
1036  $ work, lh, work( lh+1 ), lw, iinfo )
1037 *
1038 * Compute D3 from the 2-stage Upper case
1039 *
1040  CALL scopy( n, sd, 1, d3, 1 )
1041  IF( n.GT.0 )
1042  $ CALL scopy( n-1, se, 1, work, 1 )
1043 *
1044  CALL ssteqr( 'N', n, d3, work, work( n+1 ), ldu,
1045  $ work( n+1 ), iinfo )
1046  IF( iinfo.NE.0 ) THEN
1047  WRITE( nounit, fmt = 9999 )'SSTEQR(N)', iinfo, n, jtype,
1048  $ ioldsd
1049  info = abs( iinfo )
1050  IF( iinfo.LT.0 ) THEN
1051  RETURN
1052  ELSE
1053  result( 4 ) = ulpinv
1054  GO TO 280
1055  END IF
1056  END IF
1057 *
1058 *
1059 * Do Tests 3 and 4 which are similar to 11 and 12 but with the
1060 * D1 computed using the standard 1-stage reduction as reference
1061 *
1062  ntest = 4
1063  temp1 = zero
1064  temp2 = zero
1065  temp3 = zero
1066  temp4 = zero
1067 *
1068  DO 151 j = 1, n
1069  temp1 = max( temp1, abs( d1( j ) ), abs( d2( j ) ) )
1070  temp2 = max( temp2, abs( d1( j )-d2( j ) ) )
1071  temp3 = max( temp3, abs( d1( j ) ), abs( d3( j ) ) )
1072  temp4 = max( temp4, abs( d1( j )-d3( j ) ) )
1073  151 CONTINUE
1074 *
1075  result( 3 ) = temp2 / max( unfl, ulp*max( temp1, temp2 ) )
1076  result( 4 ) = temp4 / max( unfl, ulp*max( temp3, temp4 ) )
1077 *
1078 * Store the upper triangle of A in AP
1079 *
1080  i = 0
1081  DO 120 jc = 1, n
1082  DO 110 jr = 1, jc
1083  i = i + 1
1084  ap( i ) = a( jr, jc )
1085  110 CONTINUE
1086  120 CONTINUE
1087 *
1088 * Call SSPTRD and SOPGTR to compute S and U from AP
1089 *
1090  CALL scopy( nap, ap, 1, vp, 1 )
1091 *
1092  ntest = 5
1093  CALL ssptrd( 'U', n, vp, sd, se, tau, iinfo )
1094 *
1095  IF( iinfo.NE.0 ) THEN
1096  WRITE( nounit, fmt = 9999 )'SSPTRD(U)', iinfo, n, jtype,
1097  $ ioldsd
1098  info = abs( iinfo )
1099  IF( iinfo.LT.0 ) THEN
1100  RETURN
1101  ELSE
1102  result( 5 ) = ulpinv
1103  GO TO 280
1104  END IF
1105  END IF
1106 *
1107  ntest = 6
1108  CALL sopgtr( 'U', n, vp, tau, u, ldu, work, iinfo )
1109  IF( iinfo.NE.0 ) THEN
1110  WRITE( nounit, fmt = 9999 )'SOPGTR(U)', iinfo, n, jtype,
1111  $ ioldsd
1112  info = abs( iinfo )
1113  IF( iinfo.LT.0 ) THEN
1114  RETURN
1115  ELSE
1116  result( 6 ) = ulpinv
1117  GO TO 280
1118  END IF
1119  END IF
1120 *
1121 * Do tests 5 and 6
1122 *
1123  CALL sspt21( 2, 'Upper', n, 1, ap, sd, se, u, ldu, vp, tau,
1124  $ work, result( 5 ) )
1125  CALL sspt21( 3, 'Upper', n, 1, ap, sd, se, u, ldu, vp, tau,
1126  $ work, result( 6 ) )
1127 *
1128 * Store the lower triangle of A in AP
1129 *
1130  i = 0
1131  DO 140 jc = 1, n
1132  DO 130 jr = jc, n
1133  i = i + 1
1134  ap( i ) = a( jr, jc )
1135  130 CONTINUE
1136  140 CONTINUE
1137 *
1138 * Call SSPTRD and SOPGTR to compute S and U from AP
1139 *
1140  CALL scopy( nap, ap, 1, vp, 1 )
1141 *
1142  ntest = 7
1143  CALL ssptrd( 'L', n, vp, sd, se, tau, iinfo )
1144 *
1145  IF( iinfo.NE.0 ) THEN
1146  WRITE( nounit, fmt = 9999 )'SSPTRD(L)', iinfo, n, jtype,
1147  $ ioldsd
1148  info = abs( iinfo )
1149  IF( iinfo.LT.0 ) THEN
1150  RETURN
1151  ELSE
1152  result( 7 ) = ulpinv
1153  GO TO 280
1154  END IF
1155  END IF
1156 *
1157  ntest = 8
1158  CALL sopgtr( 'L', n, vp, tau, u, ldu, work, iinfo )
1159  IF( iinfo.NE.0 ) THEN
1160  WRITE( nounit, fmt = 9999 )'SOPGTR(L)', iinfo, n, jtype,
1161  $ ioldsd
1162  info = abs( iinfo )
1163  IF( iinfo.LT.0 ) THEN
1164  RETURN
1165  ELSE
1166  result( 8 ) = ulpinv
1167  GO TO 280
1168  END IF
1169  END IF
1170 *
1171  CALL sspt21( 2, 'Lower', n, 1, ap, sd, se, u, ldu, vp, tau,
1172  $ work, result( 7 ) )
1173  CALL sspt21( 3, 'Lower', n, 1, ap, sd, se, u, ldu, vp, tau,
1174  $ work, result( 8 ) )
1175 *
1176 * Call SSTEQR to compute D1, D2, and Z, do tests.
1177 *
1178 * Compute D1 and Z
1179 *
1180  CALL scopy( n, sd, 1, d1, 1 )
1181  IF( n.GT.0 )
1182  $ CALL scopy( n-1, se, 1, work, 1 )
1183  CALL slaset( 'Full', n, n, zero, one, z, ldu )
1184 *
1185  ntest = 9
1186  CALL ssteqr( 'V', n, d1, work, z, ldu, work( n+1 ), iinfo )
1187  IF( iinfo.NE.0 ) THEN
1188  WRITE( nounit, fmt = 9999 )'SSTEQR(V)', iinfo, n, jtype,
1189  $ ioldsd
1190  info = abs( iinfo )
1191  IF( iinfo.LT.0 ) THEN
1192  RETURN
1193  ELSE
1194  result( 9 ) = ulpinv
1195  GO TO 280
1196  END IF
1197  END IF
1198 *
1199 * Compute D2
1200 *
1201  CALL scopy( n, sd, 1, d2, 1 )
1202  IF( n.GT.0 )
1203  $ CALL scopy( n-1, se, 1, work, 1 )
1204 *
1205  ntest = 11
1206  CALL ssteqr( 'N', n, d2, work, work( n+1 ), ldu,
1207  $ work( n+1 ), iinfo )
1208  IF( iinfo.NE.0 ) THEN
1209  WRITE( nounit, fmt = 9999 )'SSTEQR(N)', iinfo, n, jtype,
1210  $ ioldsd
1211  info = abs( iinfo )
1212  IF( iinfo.LT.0 ) THEN
1213  RETURN
1214  ELSE
1215  result( 11 ) = ulpinv
1216  GO TO 280
1217  END IF
1218  END IF
1219 *
1220 * Compute D3 (using PWK method)
1221 *
1222  CALL scopy( n, sd, 1, d3, 1 )
1223  IF( n.GT.0 )
1224  $ CALL scopy( n-1, se, 1, work, 1 )
1225 *
1226  ntest = 12
1227  CALL ssterf( n, d3, work, iinfo )
1228  IF( iinfo.NE.0 ) THEN
1229  WRITE( nounit, fmt = 9999 )'SSTERF', iinfo, n, jtype,
1230  $ ioldsd
1231  info = abs( iinfo )
1232  IF( iinfo.LT.0 ) THEN
1233  RETURN
1234  ELSE
1235  result( 12 ) = ulpinv
1236  GO TO 280
1237  END IF
1238  END IF
1239 *
1240 * Do Tests 9 and 10
1241 *
1242  CALL sstt21( n, 0, sd, se, d1, dumma, z, ldu, work,
1243  $ result( 9 ) )
1244 *
1245 * Do Tests 11 and 12
1246 *
1247  temp1 = zero
1248  temp2 = zero
1249  temp3 = zero
1250  temp4 = zero
1251 *
1252  DO 150 j = 1, n
1253  temp1 = max( temp1, abs( d1( j ) ), abs( d2( j ) ) )
1254  temp2 = max( temp2, abs( d1( j )-d2( j ) ) )
1255  temp3 = max( temp3, abs( d1( j ) ), abs( d3( j ) ) )
1256  temp4 = max( temp4, abs( d1( j )-d3( j ) ) )
1257  150 CONTINUE
1258 *
1259  result( 11 ) = temp2 / max( unfl, ulp*max( temp1, temp2 ) )
1260  result( 12 ) = temp4 / max( unfl, ulp*max( temp3, temp4 ) )
1261 *
1262 * Do Test 13 -- Sturm Sequence Test of Eigenvalues
1263 * Go up by factors of two until it succeeds
1264 *
1265  ntest = 13
1266  temp1 = thresh*( half-ulp )
1267 *
1268  DO 160 j = 0, log2ui
1269  CALL sstech( n, sd, se, d1, temp1, work, iinfo )
1270  IF( iinfo.EQ.0 )
1271  $ GO TO 170
1272  temp1 = temp1*two
1273  160 CONTINUE
1274 *
1275  170 CONTINUE
1276  result( 13 ) = temp1
1277 *
1278 * For positive definite matrices ( JTYPE.GT.15 ) call SPTEQR
1279 * and do tests 14, 15, and 16 .
1280 *
1281  IF( jtype.GT.15 ) THEN
1282 *
1283 * Compute D4 and Z4
1284 *
1285  CALL scopy( n, sd, 1, d4, 1 )
1286  IF( n.GT.0 )
1287  $ CALL scopy( n-1, se, 1, work, 1 )
1288  CALL slaset( 'Full', n, n, zero, one, z, ldu )
1289 *
1290  ntest = 14
1291  CALL spteqr( 'V', n, d4, work, z, ldu, work( n+1 ),
1292  $ iinfo )
1293  IF( iinfo.NE.0 ) THEN
1294  WRITE( nounit, fmt = 9999 )'SPTEQR(V)', iinfo, n,
1295  $ jtype, ioldsd
1296  info = abs( iinfo )
1297  IF( iinfo.LT.0 ) THEN
1298  RETURN
1299  ELSE
1300  result( 14 ) = ulpinv
1301  GO TO 280
1302  END IF
1303  END IF
1304 *
1305 * Do Tests 14 and 15
1306 *
1307  CALL sstt21( n, 0, sd, se, d4, dumma, z, ldu, work,
1308  $ result( 14 ) )
1309 *
1310 * Compute D5
1311 *
1312  CALL scopy( n, sd, 1, d5, 1 )
1313  IF( n.GT.0 )
1314  $ CALL scopy( n-1, se, 1, work, 1 )
1315 *
1316  ntest = 16
1317  CALL spteqr( 'N', n, d5, work, z, ldu, work( n+1 ),
1318  $ iinfo )
1319  IF( iinfo.NE.0 ) THEN
1320  WRITE( nounit, fmt = 9999 )'SPTEQR(N)', iinfo, n,
1321  $ jtype, ioldsd
1322  info = abs( iinfo )
1323  IF( iinfo.LT.0 ) THEN
1324  RETURN
1325  ELSE
1326  result( 16 ) = ulpinv
1327  GO TO 280
1328  END IF
1329  END IF
1330 *
1331 * Do Test 16
1332 *
1333  temp1 = zero
1334  temp2 = zero
1335  DO 180 j = 1, n
1336  temp1 = max( temp1, abs( d4( j ) ), abs( d5( j ) ) )
1337  temp2 = max( temp2, abs( d4( j )-d5( j ) ) )
1338  180 CONTINUE
1339 *
1340  result( 16 ) = temp2 / max( unfl,
1341  $ hun*ulp*max( temp1, temp2 ) )
1342  ELSE
1343  result( 14 ) = zero
1344  result( 15 ) = zero
1345  result( 16 ) = zero
1346  END IF
1347 *
1348 * Call SSTEBZ with different options and do tests 17-18.
1349 *
1350 * If S is positive definite and diagonally dominant,
1351 * ask for all eigenvalues with high relative accuracy.
1352 *
1353  vl = zero
1354  vu = zero
1355  il = 0
1356  iu = 0
1357  IF( jtype.EQ.21 ) THEN
1358  ntest = 17
1359  abstol = unfl + unfl
1360  CALL sstebz( 'A', 'E', n, vl, vu, il, iu, abstol, sd, se,
1361  $ m, nsplit, wr, iwork( 1 ), iwork( n+1 ),
1362  $ work, iwork( 2*n+1 ), iinfo )
1363  IF( iinfo.NE.0 ) THEN
1364  WRITE( nounit, fmt = 9999 )'SSTEBZ(A,rel)', iinfo, n,
1365  $ jtype, ioldsd
1366  info = abs( iinfo )
1367  IF( iinfo.LT.0 ) THEN
1368  RETURN
1369  ELSE
1370  result( 17 ) = ulpinv
1371  GO TO 280
1372  END IF
1373  END IF
1374 *
1375 * Do test 17
1376 *
1377  temp2 = two*( two*n-one )*ulp*( one+eight*half**2 ) /
1378  $ ( one-half )**4
1379 *
1380  temp1 = zero
1381  DO 190 j = 1, n
1382  temp1 = max( temp1, abs( d4( j )-wr( n-j+1 ) ) /
1383  $ ( abstol+abs( d4( j ) ) ) )
1384  190 CONTINUE
1385 *
1386  result( 17 ) = temp1 / temp2
1387  ELSE
1388  result( 17 ) = zero
1389  END IF
1390 *
1391 * Now ask for all eigenvalues with high absolute accuracy.
1392 *
1393  ntest = 18
1394  abstol = unfl + unfl
1395  CALL sstebz( 'A', 'E', n, vl, vu, il, iu, abstol, sd, se, m,
1396  $ nsplit, wa1, iwork( 1 ), iwork( n+1 ), work,
1397  $ iwork( 2*n+1 ), iinfo )
1398  IF( iinfo.NE.0 ) THEN
1399  WRITE( nounit, fmt = 9999 )'SSTEBZ(A)', iinfo, n, jtype,
1400  $ ioldsd
1401  info = abs( iinfo )
1402  IF( iinfo.LT.0 ) THEN
1403  RETURN
1404  ELSE
1405  result( 18 ) = ulpinv
1406  GO TO 280
1407  END IF
1408  END IF
1409 *
1410 * Do test 18
1411 *
1412  temp1 = zero
1413  temp2 = zero
1414  DO 200 j = 1, n
1415  temp1 = max( temp1, abs( d3( j ) ), abs( wa1( j ) ) )
1416  temp2 = max( temp2, abs( d3( j )-wa1( j ) ) )
1417  200 CONTINUE
1418 *
1419  result( 18 ) = temp2 / max( unfl, ulp*max( temp1, temp2 ) )
1420 *
1421 * Choose random values for IL and IU, and ask for the
1422 * IL-th through IU-th eigenvalues.
1423 *
1424  ntest = 19
1425  IF( n.LE.1 ) THEN
1426  il = 1
1427  iu = n
1428  ELSE
1429  il = 1 + ( n-1 )*int( slarnd( 1, iseed2 ) )
1430  iu = 1 + ( n-1 )*int( slarnd( 1, iseed2 ) )
1431  IF( iu.LT.il ) THEN
1432  itemp = iu
1433  iu = il
1434  il = itemp
1435  END IF
1436  END IF
1437 *
1438  CALL sstebz( 'I', 'E', n, vl, vu, il, iu, abstol, sd, se,
1439  $ m2, nsplit, wa2, iwork( 1 ), iwork( n+1 ),
1440  $ work, iwork( 2*n+1 ), iinfo )
1441  IF( iinfo.NE.0 ) THEN
1442  WRITE( nounit, fmt = 9999 )'SSTEBZ(I)', iinfo, n, jtype,
1443  $ ioldsd
1444  info = abs( iinfo )
1445  IF( iinfo.LT.0 ) THEN
1446  RETURN
1447  ELSE
1448  result( 19 ) = ulpinv
1449  GO TO 280
1450  END IF
1451  END IF
1452 *
1453 * Determine the values VL and VU of the IL-th and IU-th
1454 * eigenvalues and ask for all eigenvalues in this range.
1455 *
1456  IF( n.GT.0 ) THEN
1457  IF( il.NE.1 ) THEN
1458  vl = wa1( il ) - max( half*( wa1( il )-wa1( il-1 ) ),
1459  $ ulp*anorm, two*rtunfl )
1460  ELSE
1461  vl = wa1( 1 ) - max( half*( wa1( n )-wa1( 1 ) ),
1462  $ ulp*anorm, two*rtunfl )
1463  END IF
1464  IF( iu.NE.n ) THEN
1465  vu = wa1( iu ) + max( half*( wa1( iu+1 )-wa1( iu ) ),
1466  $ ulp*anorm, two*rtunfl )
1467  ELSE
1468  vu = wa1( n ) + max( half*( wa1( n )-wa1( 1 ) ),
1469  $ ulp*anorm, two*rtunfl )
1470  END IF
1471  ELSE
1472  vl = zero
1473  vu = one
1474  END IF
1475 *
1476  CALL sstebz( 'V', 'E', n, vl, vu, il, iu, abstol, sd, se,
1477  $ m3, nsplit, wa3, iwork( 1 ), iwork( n+1 ),
1478  $ work, iwork( 2*n+1 ), iinfo )
1479  IF( iinfo.NE.0 ) THEN
1480  WRITE( nounit, fmt = 9999 )'SSTEBZ(V)', iinfo, n, jtype,
1481  $ ioldsd
1482  info = abs( iinfo )
1483  IF( iinfo.LT.0 ) THEN
1484  RETURN
1485  ELSE
1486  result( 19 ) = ulpinv
1487  GO TO 280
1488  END IF
1489  END IF
1490 *
1491  IF( m3.EQ.0 .AND. n.NE.0 ) THEN
1492  result( 19 ) = ulpinv
1493  GO TO 280
1494  END IF
1495 *
1496 * Do test 19
1497 *
1498  temp1 = ssxt1( 1, wa2, m2, wa3, m3, abstol, ulp, unfl )
1499  temp2 = ssxt1( 1, wa3, m3, wa2, m2, abstol, ulp, unfl )
1500  IF( n.GT.0 ) THEN
1501  temp3 = max( abs( wa1( n ) ), abs( wa1( 1 ) ) )
1502  ELSE
1503  temp3 = zero
1504  END IF
1505 *
1506  result( 19 ) = ( temp1+temp2 ) / max( unfl, temp3*ulp )
1507 *
1508 * Call SSTEIN to compute eigenvectors corresponding to
1509 * eigenvalues in WA1. (First call SSTEBZ again, to make sure
1510 * it returns these eigenvalues in the correct order.)
1511 *
1512  ntest = 21
1513  CALL sstebz( 'A', 'B', n, vl, vu, il, iu, abstol, sd, se, m,
1514  $ nsplit, wa1, iwork( 1 ), iwork( n+1 ), work,
1515  $ iwork( 2*n+1 ), iinfo )
1516  IF( iinfo.NE.0 ) THEN
1517  WRITE( nounit, fmt = 9999 )'SSTEBZ(A,B)', iinfo, n,
1518  $ jtype, ioldsd
1519  info = abs( iinfo )
1520  IF( iinfo.LT.0 ) THEN
1521  RETURN
1522  ELSE
1523  result( 20 ) = ulpinv
1524  result( 21 ) = ulpinv
1525  GO TO 280
1526  END IF
1527  END IF
1528 *
1529  CALL sstein( n, sd, se, m, wa1, iwork( 1 ), iwork( n+1 ), z,
1530  $ ldu, work, iwork( 2*n+1 ), iwork( 3*n+1 ),
1531  $ iinfo )
1532  IF( iinfo.NE.0 ) THEN
1533  WRITE( nounit, fmt = 9999 )'SSTEIN', iinfo, n, jtype,
1534  $ ioldsd
1535  info = abs( iinfo )
1536  IF( iinfo.LT.0 ) THEN
1537  RETURN
1538  ELSE
1539  result( 20 ) = ulpinv
1540  result( 21 ) = ulpinv
1541  GO TO 280
1542  END IF
1543  END IF
1544 *
1545 * Do tests 20 and 21
1546 *
1547  CALL sstt21( n, 0, sd, se, wa1, dumma, z, ldu, work,
1548  $ result( 20 ) )
1549 *
1550 * Call SSTEDC(I) to compute D1 and Z, do tests.
1551 *
1552 * Compute D1 and Z
1553 *
1554  CALL scopy( n, sd, 1, d1, 1 )
1555  IF( n.GT.0 )
1556  $ CALL scopy( n-1, se, 1, work, 1 )
1557  CALL slaset( 'Full', n, n, zero, one, z, ldu )
1558 *
1559  ntest = 22
1560  CALL sstedc( 'I', n, d1, work, z, ldu, work( n+1 ), lwedc-n,
1561  $ iwork, liwedc, iinfo )
1562  IF( iinfo.NE.0 ) THEN
1563  WRITE( nounit, fmt = 9999 )'SSTEDC(I)', iinfo, n, jtype,
1564  $ ioldsd
1565  info = abs( iinfo )
1566  IF( iinfo.LT.0 ) THEN
1567  RETURN
1568  ELSE
1569  result( 22 ) = ulpinv
1570  GO TO 280
1571  END IF
1572  END IF
1573 *
1574 * Do Tests 22 and 23
1575 *
1576  CALL sstt21( n, 0, sd, se, d1, dumma, z, ldu, work,
1577  $ result( 22 ) )
1578 *
1579 * Call SSTEDC(V) to compute D1 and Z, do tests.
1580 *
1581 * Compute D1 and Z
1582 *
1583  CALL scopy( n, sd, 1, d1, 1 )
1584  IF( n.GT.0 )
1585  $ CALL scopy( n-1, se, 1, work, 1 )
1586  CALL slaset( 'Full', n, n, zero, one, z, ldu )
1587 *
1588  ntest = 24
1589  CALL sstedc( 'V', n, d1, work, z, ldu, work( n+1 ), lwedc-n,
1590  $ iwork, liwedc, iinfo )
1591  IF( iinfo.NE.0 ) THEN
1592  WRITE( nounit, fmt = 9999 )'SSTEDC(V)', iinfo, n, jtype,
1593  $ ioldsd
1594  info = abs( iinfo )
1595  IF( iinfo.LT.0 ) THEN
1596  RETURN
1597  ELSE
1598  result( 24 ) = ulpinv
1599  GO TO 280
1600  END IF
1601  END IF
1602 *
1603 * Do Tests 24 and 25
1604 *
1605  CALL sstt21( n, 0, sd, se, d1, dumma, z, ldu, work,
1606  $ result( 24 ) )
1607 *
1608 * Call SSTEDC(N) to compute D2, do tests.
1609 *
1610 * Compute D2
1611 *
1612  CALL scopy( n, sd, 1, d2, 1 )
1613  IF( n.GT.0 )
1614  $ CALL scopy( n-1, se, 1, work, 1 )
1615  CALL slaset( 'Full', n, n, zero, one, z, ldu )
1616 *
1617  ntest = 26
1618  CALL sstedc( 'N', n, d2, work, z, ldu, work( n+1 ), lwedc-n,
1619  $ iwork, liwedc, iinfo )
1620  IF( iinfo.NE.0 ) THEN
1621  WRITE( nounit, fmt = 9999 )'SSTEDC(N)', iinfo, n, jtype,
1622  $ ioldsd
1623  info = abs( iinfo )
1624  IF( iinfo.LT.0 ) THEN
1625  RETURN
1626  ELSE
1627  result( 26 ) = ulpinv
1628  GO TO 280
1629  END IF
1630  END IF
1631 *
1632 * Do Test 26
1633 *
1634  temp1 = zero
1635  temp2 = zero
1636 *
1637  DO 210 j = 1, n
1638  temp1 = max( temp1, abs( d1( j ) ), abs( d2( j ) ) )
1639  temp2 = max( temp2, abs( d1( j )-d2( j ) ) )
1640  210 CONTINUE
1641 *
1642  result( 26 ) = temp2 / max( unfl, ulp*max( temp1, temp2 ) )
1643 *
1644 * Only test SSTEMR if IEEE compliant
1645 *
1646  IF( ilaenv( 10, 'SSTEMR', 'VA', 1, 0, 0, 0 ).EQ.1 .AND.
1647  $ ilaenv( 11, 'SSTEMR', 'VA', 1, 0, 0, 0 ).EQ.1 ) THEN
1648 *
1649 * Call SSTEMR, do test 27 (relative eigenvalue accuracy)
1650 *
1651 * If S is positive definite and diagonally dominant,
1652 * ask for all eigenvalues with high relative accuracy.
1653 *
1654  vl = zero
1655  vu = zero
1656  il = 0
1657  iu = 0
1658  IF( jtype.EQ.21 .AND. srel ) THEN
1659  ntest = 27
1660  abstol = unfl + unfl
1661  CALL sstemr( 'V', 'A', n, sd, se, vl, vu, il, iu,
1662  $ m, wr, z, ldu, n, iwork( 1 ), tryrac,
1663  $ work, lwork, iwork( 2*n+1 ), lwork-2*n,
1664  $ iinfo )
1665  IF( iinfo.NE.0 ) THEN
1666  WRITE( nounit, fmt = 9999 )'SSTEMR(V,A,rel)',
1667  $ iinfo, n, jtype, ioldsd
1668  info = abs( iinfo )
1669  IF( iinfo.LT.0 ) THEN
1670  RETURN
1671  ELSE
1672  result( 27 ) = ulpinv
1673  GO TO 270
1674  END IF
1675  END IF
1676 *
1677 * Do test 27
1678 *
1679  temp2 = two*( two*n-one )*ulp*( one+eight*half**2 ) /
1680  $ ( one-half )**4
1681 *
1682  temp1 = zero
1683  DO 220 j = 1, n
1684  temp1 = max( temp1, abs( d4( j )-wr( n-j+1 ) ) /
1685  $ ( abstol+abs( d4( j ) ) ) )
1686  220 CONTINUE
1687 *
1688  result( 27 ) = temp1 / temp2
1689 *
1690  il = 1 + ( n-1 )*int( slarnd( 1, iseed2 ) )
1691  iu = 1 + ( n-1 )*int( slarnd( 1, iseed2 ) )
1692  IF( iu.LT.il ) THEN
1693  itemp = iu
1694  iu = il
1695  il = itemp
1696  END IF
1697 *
1698  IF( srange ) THEN
1699  ntest = 28
1700  abstol = unfl + unfl
1701  CALL sstemr( 'V', 'I', n, sd, se, vl, vu, il, iu,
1702  $ m, wr, z, ldu, n, iwork( 1 ), tryrac,
1703  $ work, lwork, iwork( 2*n+1 ),
1704  $ lwork-2*n, iinfo )
1705 *
1706  IF( iinfo.NE.0 ) THEN
1707  WRITE( nounit, fmt = 9999 )'SSTEMR(V,I,rel)',
1708  $ iinfo, n, jtype, ioldsd
1709  info = abs( iinfo )
1710  IF( iinfo.LT.0 ) THEN
1711  RETURN
1712  ELSE
1713  result( 28 ) = ulpinv
1714  GO TO 270
1715  END IF
1716  END IF
1717 *
1718 *
1719 * Do test 28
1720 *
1721  temp2 = two*( two*n-one )*ulp*
1722  $ ( one+eight*half**2 ) / ( one-half )**4
1723 *
1724  temp1 = zero
1725  DO 230 j = il, iu
1726  temp1 = max( temp1, abs( wr( j-il+1 )-d4( n-j+
1727  $ 1 ) ) / ( abstol+abs( wr( j-il+1 ) ) ) )
1728  230 CONTINUE
1729 *
1730  result( 28 ) = temp1 / temp2
1731  ELSE
1732  result( 28 ) = zero
1733  END IF
1734  ELSE
1735  result( 27 ) = zero
1736  result( 28 ) = zero
1737  END IF
1738 *
1739 * Call SSTEMR(V,I) to compute D1 and Z, do tests.
1740 *
1741 * Compute D1 and Z
1742 *
1743  CALL scopy( n, sd, 1, d5, 1 )
1744  IF( n.GT.0 )
1745  $ CALL scopy( n-1, se, 1, work, 1 )
1746  CALL slaset( 'Full', n, n, zero, one, z, ldu )
1747 *
1748  IF( srange ) THEN
1749  ntest = 29
1750  il = 1 + ( n-1 )*int( slarnd( 1, iseed2 ) )
1751  iu = 1 + ( n-1 )*int( slarnd( 1, iseed2 ) )
1752  IF( iu.LT.il ) THEN
1753  itemp = iu
1754  iu = il
1755  il = itemp
1756  END IF
1757  CALL sstemr( 'V', 'I', n, d5, work, vl, vu, il, iu,
1758  $ m, d1, z, ldu, n, iwork( 1 ), tryrac,
1759  $ work( n+1 ), lwork-n, iwork( 2*n+1 ),
1760  $ liwork-2*n, iinfo )
1761  IF( iinfo.NE.0 ) THEN
1762  WRITE( nounit, fmt = 9999 )'SSTEMR(V,I)', iinfo,
1763  $ n, jtype, ioldsd
1764  info = abs( iinfo )
1765  IF( iinfo.LT.0 ) THEN
1766  RETURN
1767  ELSE
1768  result( 29 ) = ulpinv
1769  GO TO 280
1770  END IF
1771  END IF
1772 *
1773 * Do Tests 29 and 30
1774 *
1775  CALL sstt22( n, m, 0, sd, se, d1, dumma, z, ldu, work,
1776  $ m, result( 29 ) )
1777 *
1778 * Call SSTEMR to compute D2, do tests.
1779 *
1780 * Compute D2
1781 *
1782  CALL scopy( n, sd, 1, d5, 1 )
1783  IF( n.GT.0 )
1784  $ CALL scopy( n-1, se, 1, work, 1 )
1785 *
1786  ntest = 31
1787  CALL sstemr( 'N', 'I', n, d5, work, vl, vu, il, iu,
1788  $ m, d2, z, ldu, n, iwork( 1 ), tryrac,
1789  $ work( n+1 ), lwork-n, iwork( 2*n+1 ),
1790  $ liwork-2*n, iinfo )
1791  IF( iinfo.NE.0 ) THEN
1792  WRITE( nounit, fmt = 9999 )'SSTEMR(N,I)', iinfo,
1793  $ n, jtype, ioldsd
1794  info = abs( iinfo )
1795  IF( iinfo.LT.0 ) THEN
1796  RETURN
1797  ELSE
1798  result( 31 ) = ulpinv
1799  GO TO 280
1800  END IF
1801  END IF
1802 *
1803 * Do Test 31
1804 *
1805  temp1 = zero
1806  temp2 = zero
1807 *
1808  DO 240 j = 1, iu - il + 1
1809  temp1 = max( temp1, abs( d1( j ) ),
1810  $ abs( d2( j ) ) )
1811  temp2 = max( temp2, abs( d1( j )-d2( j ) ) )
1812  240 CONTINUE
1813 *
1814  result( 31 ) = temp2 / max( unfl,
1815  $ ulp*max( temp1, temp2 ) )
1816 *
1817 *
1818 * Call SSTEMR(V,V) to compute D1 and Z, do tests.
1819 *
1820 * Compute D1 and Z
1821 *
1822  CALL scopy( n, sd, 1, d5, 1 )
1823  IF( n.GT.0 )
1824  $ CALL scopy( n-1, se, 1, work, 1 )
1825  CALL slaset( 'Full', n, n, zero, one, z, ldu )
1826 *
1827  ntest = 32
1828 *
1829  IF( n.GT.0 ) THEN
1830  IF( il.NE.1 ) THEN
1831  vl = d2( il ) - max( half*
1832  $ ( d2( il )-d2( il-1 ) ), ulp*anorm,
1833  $ two*rtunfl )
1834  ELSE
1835  vl = d2( 1 ) - max( half*( d2( n )-d2( 1 ) ),
1836  $ ulp*anorm, two*rtunfl )
1837  END IF
1838  IF( iu.NE.n ) THEN
1839  vu = d2( iu ) + max( half*
1840  $ ( d2( iu+1 )-d2( iu ) ), ulp*anorm,
1841  $ two*rtunfl )
1842  ELSE
1843  vu = d2( n ) + max( half*( d2( n )-d2( 1 ) ),
1844  $ ulp*anorm, two*rtunfl )
1845  END IF
1846  ELSE
1847  vl = zero
1848  vu = one
1849  END IF
1850 *
1851  CALL sstemr( 'V', 'V', n, d5, work, vl, vu, il, iu,
1852  $ m, d1, z, ldu, n, iwork( 1 ), tryrac,
1853  $ work( n+1 ), lwork-n, iwork( 2*n+1 ),
1854  $ liwork-2*n, iinfo )
1855  IF( iinfo.NE.0 ) THEN
1856  WRITE( nounit, fmt = 9999 )'SSTEMR(V,V)', iinfo,
1857  $ n, jtype, ioldsd
1858  info = abs( iinfo )
1859  IF( iinfo.LT.0 ) THEN
1860  RETURN
1861  ELSE
1862  result( 32 ) = ulpinv
1863  GO TO 280
1864  END IF
1865  END IF
1866 *
1867 * Do Tests 32 and 33
1868 *
1869  CALL sstt22( n, m, 0, sd, se, d1, dumma, z, ldu, work,
1870  $ m, result( 32 ) )
1871 *
1872 * Call SSTEMR to compute D2, do tests.
1873 *
1874 * Compute D2
1875 *
1876  CALL scopy( n, sd, 1, d5, 1 )
1877  IF( n.GT.0 )
1878  $ CALL scopy( n-1, se, 1, work, 1 )
1879 *
1880  ntest = 34
1881  CALL sstemr( 'N', 'V', n, d5, work, vl, vu, il, iu,
1882  $ m, d2, z, ldu, n, iwork( 1 ), tryrac,
1883  $ work( n+1 ), lwork-n, iwork( 2*n+1 ),
1884  $ liwork-2*n, iinfo )
1885  IF( iinfo.NE.0 ) THEN
1886  WRITE( nounit, fmt = 9999 )'SSTEMR(N,V)', iinfo,
1887  $ n, jtype, ioldsd
1888  info = abs( iinfo )
1889  IF( iinfo.LT.0 ) THEN
1890  RETURN
1891  ELSE
1892  result( 34 ) = ulpinv
1893  GO TO 280
1894  END IF
1895  END IF
1896 *
1897 * Do Test 34
1898 *
1899  temp1 = zero
1900  temp2 = zero
1901 *
1902  DO 250 j = 1, iu - il + 1
1903  temp1 = max( temp1, abs( d1( j ) ),
1904  $ abs( d2( j ) ) )
1905  temp2 = max( temp2, abs( d1( j )-d2( j ) ) )
1906  250 CONTINUE
1907 *
1908  result( 34 ) = temp2 / max( unfl,
1909  $ ulp*max( temp1, temp2 ) )
1910  ELSE
1911  result( 29 ) = zero
1912  result( 30 ) = zero
1913  result( 31 ) = zero
1914  result( 32 ) = zero
1915  result( 33 ) = zero
1916  result( 34 ) = zero
1917  END IF
1918 *
1919 *
1920 * Call SSTEMR(V,A) to compute D1 and Z, do tests.
1921 *
1922 * Compute D1 and Z
1923 *
1924  CALL scopy( n, sd, 1, d5, 1 )
1925  IF( n.GT.0 )
1926  $ CALL scopy( n-1, se, 1, work, 1 )
1927 *
1928  ntest = 35
1929 *
1930  CALL sstemr( 'V', 'A', n, d5, work, vl, vu, il, iu,
1931  $ m, d1, z, ldu, n, iwork( 1 ), tryrac,
1932  $ work( n+1 ), lwork-n, iwork( 2*n+1 ),
1933  $ liwork-2*n, iinfo )
1934  IF( iinfo.NE.0 ) THEN
1935  WRITE( nounit, fmt = 9999 )'SSTEMR(V,A)', iinfo, n,
1936  $ jtype, ioldsd
1937  info = abs( iinfo )
1938  IF( iinfo.LT.0 ) THEN
1939  RETURN
1940  ELSE
1941  result( 35 ) = ulpinv
1942  GO TO 280
1943  END IF
1944  END IF
1945 *
1946 * Do Tests 35 and 36
1947 *
1948  CALL sstt22( n, m, 0, sd, se, d1, dumma, z, ldu, work, m,
1949  $ result( 35 ) )
1950 *
1951 * Call SSTEMR to compute D2, do tests.
1952 *
1953 * Compute D2
1954 *
1955  CALL scopy( n, sd, 1, d5, 1 )
1956  IF( n.GT.0 )
1957  $ CALL scopy( n-1, se, 1, work, 1 )
1958 *
1959  ntest = 37
1960  CALL sstemr( 'N', 'A', n, d5, work, vl, vu, il, iu,
1961  $ m, d2, z, ldu, n, iwork( 1 ), tryrac,
1962  $ work( n+1 ), lwork-n, iwork( 2*n+1 ),
1963  $ liwork-2*n, iinfo )
1964  IF( iinfo.NE.0 ) THEN
1965  WRITE( nounit, fmt = 9999 )'SSTEMR(N,A)', iinfo, n,
1966  $ jtype, ioldsd
1967  info = abs( iinfo )
1968  IF( iinfo.LT.0 ) THEN
1969  RETURN
1970  ELSE
1971  result( 37 ) = ulpinv
1972  GO TO 280
1973  END IF
1974  END IF
1975 *
1976 * Do Test 34
1977 *
1978  temp1 = zero
1979  temp2 = zero
1980 *
1981  DO 260 j = 1, n
1982  temp1 = max( temp1, abs( d1( j ) ), abs( d2( j ) ) )
1983  temp2 = max( temp2, abs( d1( j )-d2( j ) ) )
1984  260 CONTINUE
1985 *
1986  result( 37 ) = temp2 / max( unfl,
1987  $ ulp*max( temp1, temp2 ) )
1988  END IF
1989  270 CONTINUE
1990  280 CONTINUE
1991  ntestt = ntestt + ntest
1992 *
1993 * End of Loop -- Check for RESULT(j) > THRESH
1994 *
1995 *
1996 * Print out tests which fail.
1997 *
1998  DO 290 jr = 1, ntest
1999  IF( result( jr ).GE.thresh ) THEN
2000 *
2001 * If this is the first test to fail,
2002 * print a header to the data file.
2003 *
2004  IF( nerrs.EQ.0 ) THEN
2005  WRITE( nounit, fmt = 9998 )'SST'
2006  WRITE( nounit, fmt = 9997 )
2007  WRITE( nounit, fmt = 9996 )
2008  WRITE( nounit, fmt = 9995 )'Symmetric'
2009  WRITE( nounit, fmt = 9994 )
2010 *
2011 * Tests performed
2012 *
2013  WRITE( nounit, fmt = 9988 )
2014  END IF
2015  nerrs = nerrs + 1
2016  WRITE( nounit, fmt = 9990 )n, ioldsd, jtype, jr,
2017  $ result( jr )
2018  END IF
2019  290 CONTINUE
2020  300 CONTINUE
2021  310 CONTINUE
2022 *
2023 * Summary
2024 *
2025  CALL slasum( 'SST', nounit, nerrs, ntestt )
2026  RETURN
2027 *
2028  9999 FORMAT( ' SCHKST2STG: ', a, ' returned INFO=', i6, '.', / 9x,
2029  $ 'N=', i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5, ')' )
2030 *
2031  9998 FORMAT( / 1x, a3, ' -- Real Symmetric eigenvalue problem' )
2032  9997 FORMAT( ' Matrix types (see SCHKST2STG for details): ' )
2033 *
2034  9996 FORMAT( / ' Special Matrices:',
2035  $ / ' 1=Zero matrix. ',
2036  $ ' 5=Diagonal: clustered entries.',
2037  $ / ' 2=Identity matrix. ',
2038  $ ' 6=Diagonal: large, evenly spaced.',
2039  $ / ' 3=Diagonal: evenly spaced entries. ',
2040  $ ' 7=Diagonal: small, evenly spaced.',
2041  $ / ' 4=Diagonal: geometr. spaced entries.' )
2042  9995 FORMAT( ' Dense ', a, ' Matrices:',
2043  $ / ' 8=Evenly spaced eigenvals. ',
2044  $ ' 12=Small, evenly spaced eigenvals.',
2045  $ / ' 9=Geometrically spaced eigenvals. ',
2046  $ ' 13=Matrix with random O(1) entries.',
2047  $ / ' 10=Clustered eigenvalues. ',
2048  $ ' 14=Matrix with large random entries.',
2049  $ / ' 11=Large, evenly spaced eigenvals. ',
2050  $ ' 15=Matrix with small random entries.' )
2051  9994 FORMAT( ' 16=Positive definite, evenly spaced eigenvalues',
2052  $ / ' 17=Positive definite, geometrically spaced eigenvlaues',
2053  $ / ' 18=Positive definite, clustered eigenvalues',
2054  $ / ' 19=Positive definite, small evenly spaced eigenvalues',
2055  $ / ' 20=Positive definite, large evenly spaced eigenvalues',
2056  $ / ' 21=Diagonally dominant tridiagonal, geometrically',
2057  $ ' spaced eigenvalues' )
2058 *
2059  9990 FORMAT( ' N=', i5, ', seed=', 4( i4, ',' ), ' type ', i2,
2060  $ ', test(', i2, ')=', g10.3 )
2061 *
2062  9988 FORMAT( / 'Test performed: see SCHKST2STG for details.', / )
2063 *
2064 * End of SCHKST2STG
2065 *
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:74
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition: slaset.f:110
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
Definition: slacpy.f:103
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
ILAENV
Definition: ilaenv.f:162
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine ssteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
SSTEQR
Definition: ssteqr.f:131
subroutine sstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
SSTEDC
Definition: sstedc.f:188
subroutine ssterf(N, D, E, INFO)
SSTERF
Definition: ssterf.f:86
subroutine sstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
SSTEBZ
Definition: sstebz.f:273
real function slarnd(IDIST, ISEED)
SLARND
Definition: slarnd.f:73
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
Definition: slatms.f:321
subroutine slatmr(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, RSIGN, GRADE, DL, MODEL, CONDL, DR, MODER, CONDR, PIVTNG, IPIVOT, KL, KU, SPARSE, ANORM, PACK, A, LDA, IWORK, INFO)
SLATMR
Definition: slatmr.f:471
subroutine ssptrd(UPLO, N, AP, D, E, TAU, INFO)
SSPTRD
Definition: ssptrd.f:150
subroutine sopgtr(UPLO, N, AP, TAU, Q, LDQ, WORK, INFO)
SOPGTR
Definition: sopgtr.f:114
subroutine sstemr(JOBZ, RANGE, N, D, E, VL, VU, IL, IU, M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK, IWORK, LIWORK, INFO)
SSTEMR
Definition: sstemr.f:321
subroutine sstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
SSTEIN
Definition: sstein.f:174
subroutine sorgtr(UPLO, N, A, LDA, TAU, WORK, LWORK, INFO)
SORGTR
Definition: sorgtr.f:123
subroutine spteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
SPTEQR
Definition: spteqr.f:145
subroutine ssytrd(UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO)
SSYTRD
Definition: ssytrd.f:192
subroutine ssytrd_2stage(VECT, UPLO, N, A, LDA, D, E, TAU, HOUS2, LHOUS2, WORK, LWORK, INFO)
SSYTRD_2STAGE
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
Definition: scopy.f:82
subroutine sstech(N, A, B, EIG, TOL, WORK, INFO)
SSTECH
Definition: sstech.f:101
subroutine sstt21(N, KBAND, AD, AE, SD, SE, U, LDU, WORK, RESULT)
SSTT21
Definition: sstt21.f:127
real function ssxt1(IJOB, D1, N1, D2, N2, ABSTOL, ULP, UNFL)
SSXT1
Definition: ssxt1.f:106
subroutine sstt22(N, M, KBAND, AD, AE, SD, SE, U, LDU, WORK, LDWORK, RESULT)
SSTT22
Definition: sstt22.f:139
subroutine ssyt21(ITYPE, UPLO, N, KBAND, A, LDA, D, E, U, LDU, V, LDV, TAU, WORK, RESULT)
SSYT21
Definition: ssyt21.f:207
subroutine sspt21(ITYPE, UPLO, N, KBAND, AP, D, E, U, LDU, VP, TAU, WORK, RESULT)
SSPT21
Definition: sspt21.f:221
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:68
subroutine slasum(TYPE, IOUNIT, IE, NRUN)
SLASUM
Definition: slasum.f:41
Here is the call graph for this function:
Here is the caller graph for this function: