LAPACK  3.10.0 LAPACK: Linear Algebra PACKage

## ◆ cchkst()

 subroutine cchkst ( integer NSIZES, integer, dimension( * ) NN, integer NTYPES, logical, dimension( * ) DOTYPE, integer, dimension( 4 ) ISEED, real THRESH, integer NOUNIT, complex, dimension( lda, * ) A, integer LDA, complex, 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, complex, dimension( ldu, * ) U, integer LDU, complex, dimension( ldu, * ) V, complex, dimension( * ) VP, complex, dimension( * ) TAU, complex, dimension( ldu, * ) Z, complex, dimension( * ) WORK, integer LWORK, real, dimension( * ) RWORK, integer LRWORK, integer, dimension( * ) IWORK, integer LIWORK, real, dimension( * ) RESULT, integer INFO )

CCHKST

Purpose:
``` CCHKST  checks the Hermitian eigenvalue problem routines.

CHETRD factors A as  U S U* , where * means conjugate transpose,
S is real symmetric tridiagonal, and U is unitary.
CHETRD can use either just the lower or just the upper triangle
of A; CCHKST 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.

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

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

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

CSTEQR factors S as  Z D1 Z* , where Z is the unitary
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.

CPTEQR factors S as  Z4 D4 Z4* , for a
Hermitian 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.

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

CSTEDC factors S as Z D1 Z* , where Z is the unitary
matrix of eigenvectors and D1 is a diagonal matrix with
the eigenvalues on the diagonal ('I' option). It may also
update an input unitary matrix, usually the output
from CHETRD/CUNGTR or CHPTRD/CUPGTR ('V' option). It may
also just compute eigenvalues ('N' option).

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

When CCHKST 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 Hermitian eigenroutines.  For each matrix, a number
of tests will be performed:

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

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

(3)     | A - V S V* | / ( |A| n ulp ) CHETRD( UPLO='L', ... )

(4)     | I - UV* | / ( n ulp )        CUNGTR( UPLO='L', ... )

(5-8)   Same as 1-4, but for CHPTRD and CUPGTR.

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

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

(11)    | D1 - D2 | / ( |D1| ulp )        CSTEQR('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 ) CPTEQR('V',...)

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

(16)    | D4 - D5 | / ( 100 |D4| ulp )       CPTEQR('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, CSTEIN

(21)    | I - Y Y* | / ( n ulp )          SSTEBZ, CSTEIN

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

(23)    | I - ZZ* | / ( n ulp )           CSTEDC('I')

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

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

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

Test 27 is disabled at the moment because CSTEMR 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
CSTEMR('V', 'A')

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

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

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

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

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

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

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

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

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

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

(37)    ( max { min | WA2(i)-WA3(j) | } +
i     j
max { min | WA3(i)-WA2(j) | } ) / ( |D3| ulp )
i     j
CSTEMR('N', 'A') vs. CSTEMR('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 unitary 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 unitary 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 unitary 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) Hermitian 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, CCHKST 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, CCHKST 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 CCHKST 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 COMPLEX 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 COMPLEX 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 CHETRD. 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 CHETRD. 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 CSTEQR 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 CSTEQR 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 CPTEQR(V). ZPTEQR 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 ZPTEQR(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 DOUBLE PRECISION array of dimension( max(NN) ) All eigenvalues of A, computed to high absolute accuracy, with different options. as computed by DSTEBZ.``` [out] U ``` U is COMPLEX array of dimension( LDU, max(NN) ). The unitary matrix computed by CHETRD + CUNGTR.``` [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 COMPLEX array of dimension( LDU, max(NN) ). The Housholder vectors computed by CHETRD 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 CHETRD, 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 CUNGTR, set those entries to 1 before using them, and then restore them later.)``` [out] VP ``` VP is COMPLEX array of dimension( max(NN)*max(NN+1)/2 ) The matrix V stored in packed format.``` [out] TAU ``` TAU is COMPLEX array of dimension( max(NN) ) The Householder factors computed by CHETRD in reducing A to tridiagonal form.``` [out] Z ``` Z is COMPLEX array of dimension( LDU, max(NN) ). The unitary matrix of eigenvectors computed by CSTEQR, CPTEQR, and CSTEIN.``` [out] WORK ``` WORK is COMPLEX 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] RWORK ` RWORK is REAL array` [in] LRWORK ``` LRWORK is INTEGER The number of entries in LRWORK (dimension( ??? )``` [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 CLATMR, CLATMS, CHETRD, CUNGTR, CSTEQR, SSTERF, or CUNMC2 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) )```

Definition at line 599 of file cchkst.f.

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