/** ======================================================================* NIST Guide to Available Math Software.* Fullsource for module SSYEVX.C from package CLAPACK.* Retrieved from NETLIB on Fri Mar 10 14:23:44 2000.* ======================================================================*/#include <f2c.h>/* Subroutine */ int sstebz_(char *range, char *order, integer *n, real *vl, 	real *vu, integer *il, integer *iu, real *abstol, real *d, real *e, 	integer *m, integer *nsplit, real *w, integer *iblock, integer *	isplit, real *work, integer *iwork, integer *info){/*  -- LAPACK routine (version 2.0) --          Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,          Courant Institute, Argonne National Lab, and Rice University          September 30, 1994       Purpose       =======       SSTEBZ computes the eigenvalues of a symmetric tridiagonal       matrix T.  The user may ask for all eigenvalues, all eigenvalues       in the half-open interval (VL, VU], or the IL-th through IU-th       eigenvalues.       To avoid overflow, the matrix must be scaled so that its       largest element is no greater than overflow**(1/2) *       underflow**(1/4) in absolute value, and for greatest       accuracy, it should not be much smaller than that.       See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal       Matrix", Report CS41, Computer Science Dept., Stanford       University, July 21, 1966.       Arguments       =========       RANGE   (input) CHARACTER               = 'A': ("All")   all eigenvalues will be found.               = 'V': ("Value") all eigenvalues in the half-open interval                                (VL, VU] will be found.               = 'I': ("Index") the IL-th through IU-th eigenvalues (of the                                entire matrix) will be found.       ORDER   (input) CHARACTER               = 'B': ("By Block") the eigenvalues will be grouped by                                   split-off block (see IBLOCK, ISPLIT) and                                   ordered from smallest to largest within                                   the block.               = 'E': ("Entire matrix")                                   the eigenvalues for the entire matrix                                   will be ordered from smallest to                                   largest.       N       (input) INTEGER               The order of the tridiagonal matrix T.  N >= 0.       VL      (input) REAL       VU      (input) REAL               If RANGE='V', the lower and upper bounds of the interval to               be searched for eigenvalues.  Eigenvalues less than or equal               to VL, or greater than VU, will not be returned.  VL < VU.               Not referenced if RANGE = 'A' or 'I'.       IL      (input) INTEGER       IU      (input) INTEGER               If RANGE='I', the indices (in ascending order) of the               smallest and largest eigenvalues to be returned.               1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.               Not referenced if RANGE = 'A' or 'V'.       ABSTOL  (input) REAL               The absolute tolerance for the eigenvalues.  An eigenvalue               (or cluster) is considered to be located if it has been               determined to lie in an interval whose width is ABSTOL or               less.  If ABSTOL is less than or equal to zero, then ULP*|T|               will be used, where |T| means the 1-norm of T.               Eigenvalues will be computed most accurately when ABSTOL is               set to twice the underflow threshold 2*SLAMCH('S'), not zero.       D       (input) REAL array, dimension (N)               The n diagonal elements of the tridiagonal matrix T.       E       (input) REAL array, dimension (N-1)               The (n-1) off-diagonal elements of the tridiagonal matrix T.       M       (output) INTEGER               The actual number of eigenvalues found. 0 <= M <= N.               (See also the description of INFO=2,3.)       NSPLIT  (output) INTEGER               The number of diagonal blocks in the matrix T.               1 <= NSPLIT <= N.       W       (output) REAL array, dimension (N)               On exit, the first M elements of W will contain the               eigenvalues.  (SSTEBZ may use the remaining N-M elements as               workspace.)       IBLOCK  (output) INTEGER array, dimension (N)               At each row/column j where E(j) is zero or small, the               matrix T is considered to split into a block diagonal               matrix.  On exit, if INFO = 0, IBLOCK(i) specifies to which               block (from 1 to the number of blocks) the eigenvalue W(i)               belongs.  (SSTEBZ may use the remaining N-M elements as               workspace.)       ISPLIT  (output) INTEGER array, dimension (N)               The splitting points, at which T breaks up into submatrices.               The first submatrix consists of rows/columns 1 to ISPLIT(1),               the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),               etc., and the NSPLIT-th consists of rows/columns               ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.               (Only the first NSPLIT elements will actually be used, but               since the user cannot know a priori what value NSPLIT will               have, N words must be reserved for ISPLIT.)       WORK    (workspace) REAL array, dimension (4*N)       IWORK   (workspace) INTEGER array, dimension (3*N)       INFO    (output) INTEGER               = 0:  successful exit               < 0:  if INFO = -i, the i-th argument had an illegal value               > 0:  some or all of the eigenvalues failed to converge or                     were not computed:                     =1 or 3: Bisection failed to converge for some                             eigenvalues; these eigenvalues are flagged by a                             negative block number.  The effect is that the                             eigenvalues may not be as accurate as the                             absolute and relative tolerances.  This is                             generally caused by unexpectedly inaccurate                             arithmetic.                     =2 or 3: RANGE='I' only: Not all of the eigenvalues                             IL:IU were found.                             Effect: M < IU+1-IL                             Cause:  non-monotonic arithmetic, causing the                                     Sturm sequence to be non-monotonic.                             Cure:   recalculate, using RANGE='A', and pick                                     out eigenvalues IL:IU.  In some cases,                                     increasing the PARAMETER "FUDGE" may                                     make things work.                     = 4:    RANGE='I', and the Gershgorin interval                             initially used was too small.  No eigenvalues                             were computed.                             Probable cause: your machine has sloppy                                             floating-point arithmetic.                             Cure: Increase the PARAMETER "FUDGE",                                   recompile, and try again.       Internal Parameters       ===================       RELFAC  REAL, default = 2.0e0               The relative tolerance.  An interval (a,b] lies within               "relative tolerance" if  b-a < RELFAC*ulp*max(|a|,|b|),               where "ulp" is the machine precision (distance from 1 to               the next larger floating point number.)       FUDGE   REAL, default = 2               A "fudge factor" to widen the Gershgorin intervals.  Ideally,               a value of 1 should work, but on machines with sloppy               arithmetic, this needs to be larger.  The default for               publicly released versions should be large enough to handle               the worst machine around.  Note that this has no effect               on accuracy of the solution.       =====================================================================          Parameter adjustments          Function Body */    /* Table of constant values */    static integer c__1 = 1;    static integer c_n1 = -1;    static integer c__3 = 3;    static integer c__2 = 2;    static integer c__0 = 0;        /* System generated locals */    integer i__1, i__2, i__3;    real r__1, r__2, r__3, r__4, r__5;    /* Builtin functions */    double sqrt(doublereal), log(doublereal);    /* Local variables */    static integer iend, ioff, iout, itmp1, j, jdisc;    extern logical lsame_(char *, char *);    static integer iinfo;    static real atoli;    static integer iwoff;    static real bnorm;    static integer itmax;    static real wkill, rtoli, tnorm;    static integer ib, jb, ie, je, nb;    static real gl;    static integer im, in, ibegin;    static real gu;    static integer iw;    static real wl;    static integer irange, idiscl;    extern doublereal slamch_(char *);    static real safemn, wu;    static integer idumma[1];    extern integer ilaenv_(integer *, char *, char *, integer *, integer *, 	    integer *, integer *, ftnlen, ftnlen);    extern /* Subroutine */ int xerbla_(char *, integer *);    static integer idiscu;    extern /* Subroutine */ int slaebz_(integer *, integer *, integer *, 	    integer *, integer *, integer *, real *, real *, real *, real *, 	    real *, real *, integer *, real *, real *, integer *, integer *, 	    real *, integer *, integer *);    static integer iorder;    static logical ncnvrg;    static real pivmin;    static logical toofew;    static integer nwl;    static real ulp, wlu, wul;    static integer nwu;    static real tmp1, tmp2;#define IDUMMA(I) idumma[(I)]#define IWORK(I) iwork[(I)-1]#define WORK(I) work[(I)-1]#define ISPLIT(I) isplit[(I)-1]#define IBLOCK(I) iblock[(I)-1]#define W(I) w[(I)-1]#define E(I) e[(I)-1]#define D(I) d[(I)-1]    *info = 0;/*     Decode RANGE */    if (lsame_(range, "A")) {	irange = 1;    } else if (lsame_(range, "V")) {	irange = 2;    } else if (lsame_(range, "I")) {	irange = 3;    } else {	irange = 0;    }/*     Decode ORDER */    if (lsame_(order, "B")) {	iorder = 2;    } else if (lsame_(order, "E")) {	iorder = 1;    } else {	iorder = 0;    }/*     Check for Errors */    if (irange <= 0) {	*info = -1;    } else if (iorder <= 0) {	*info = -2;    } else if (*n < 0) {	*info = -3;    } else if (irange == 2 && *vl >= *vu) {	*info = -5;    } else if (irange == 3 && (*il < 1 || *il > max(1,*n))) {	*info = -6;    } else if (irange == 3 && (*iu < min(*n,*il) || *iu > *n)) {	*info = -7;    }    if (*info != 0) {	i__1 = -(*info);	xerbla_("SSTEBZ", &i__1);	return 0;    }/*     Initialize error flags */    *info = 0;    ncnvrg = FALSE_;    toofew = FALSE_;/*     Quick return if possible */    *m = 0;    if (*n == 0) {	return 0;    }/*     Simplifications: */    if (irange == 3 && *il == 1 && *iu == *n) {	irange = 1;    }/*     Get machine constants          NB is the minimum vector length for vector bisection, or 0          if only scalar is to be done. */    safemn = slamch_("S");    ulp = slamch_("P");    rtoli = ulp * 2.f;    nb = ilaenv_(&c__1, "SSTEBZ", " ", n, &c_n1, &c_n1, &c_n1, 6L, 1L);    if (nb <= 1) {	nb = 0;    }/*     Special Case when N=1 */    if (*n == 1) {	*nsplit = 1;	ISPLIT(1) = 1;	if (irange == 2 && (*vl >= D(1) || *vu < D(1))) {	    *m = 0;	} else {	    W(1) = D(1);	    IBLOCK(1) = 1;	    *m = 1;	}	return 0;    }/*     Compute Splitting Points */    *nsplit = 1;    WORK(*n) = 0.f;    pivmin = 1.f;    i__1 = *n;    for (j = 2; j <= *n; ++j) {/* Computing 2nd power */	r__1 = E(j - 1);	tmp1 = r__1 * r__1;/* Computing 2nd power */	r__2 = ulp;	if ((r__1 = D(j) * D(j - 1), dabs(r__1)) * (r__2 * r__2) + safemn > 		tmp1) {	    ISPLIT(*nsplit) = j - 1;	    ++(*nsplit);	    WORK(j - 1) = 0.f;	} else {	    WORK(j - 1) = tmp1;	    pivmin = dmax(pivmin,tmp1);	}/* L10: */    }    ISPLIT(*nsplit) = *n;    pivmin *= safemn;/*     Compute Interval and ATOLI */    if (irange == 3) {/*        RANGE='I': Compute the interval containing eigenvalues                        IL through IU.             Compute Gershgorin interval for entire (split) matrix             and use it as the initial interval */	gu = D(1);	gl = D(1);	tmp1 = 0.f;