/** ======================================================================* 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>doublereal slamch_(char *cmach){/*  -- LAPACK auxiliary routine (version 2.0) --          Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,          Courant Institute, Argonne National Lab, and Rice University          October 31, 1992       Purpose       =======       SLAMCH determines single precision machine parameters.       Arguments       =========       CMACH   (input) CHARACTER*1               Specifies the value to be returned by SLAMCH:               = 'E' or 'e',   SLAMCH := eps               = 'S' or 's ,   SLAMCH := sfmin               = 'B' or 'b',   SLAMCH := base               = 'P' or 'p',   SLAMCH := eps*base               = 'N' or 'n',   SLAMCH := t               = 'R' or 'r',   SLAMCH := rnd               = 'M' or 'm',   SLAMCH := emin               = 'U' or 'u',   SLAMCH := rmin               = 'L' or 'l',   SLAMCH := emax               = 'O' or 'o',   SLAMCH := rmax               where               eps   = relative machine precision               sfmin = safe minimum, such that 1/sfmin does not overflow               base  = base of the machine               prec  = eps*base               t     = number of (base) digits in the mantissa               rnd   = 1.0 when rounding occurs in addition, 0.0 otherwise               emin  = minimum exponent before (gradual) underflow               rmin  = underflow threshold - base**(emin-1)               emax  = largest exponent before overflow               rmax  = overflow threshold  - (base**emax)*(1-eps)      ===================================================================== *//* >>Start of File<<          Initialized data */    static logical first = TRUE_;    /* System generated locals */    integer i__1;    real ret_val;    /* Builtin functions */    double pow_ri(real *, integer *);    /* Local variables */    static real base;    static integer beta;    static real emin, prec, emax;    static integer imin, imax;    static logical lrnd;    static real rmin, rmax, t, rmach;    extern logical lsame_(char *, char *);    static real small, sfmin;    extern /* Subroutine */ int slamc2_(integer *, integer *, logical *, real 	    *, integer *, real *, integer *, real *);    static integer it;    static real rnd, eps;    if (first) {	first = FALSE_;	slamc2_(&beta, &it, &lrnd, &eps, &imin, &rmin, &imax, &rmax);	base = (real) beta;	t = (real) it;	if (lrnd) {	    rnd = 1.f;	    i__1 = 1 - it;	    eps = pow_ri(&base, &i__1) / 2;	} else {	    rnd = 0.f;	    i__1 = 1 - it;	    eps = pow_ri(&base, &i__1);	}	prec = eps * base;	emin = (real) imin;	emax = (real) imax;	sfmin = rmin;	small = 1.f / rmax;	if (small >= sfmin) {/*           Use SMALL plus a bit, to avoid the possibility of rounding                causing overflow when computing  1/sfmin. */	    sfmin = small * (eps + 1.f);	}    }/*printf("cmach = %c\n", *cmach);printf("eps = %f\n", eps);printf("base = %f\n", eps);printf("rmin = %f rmax = %f\n", rmin, rmax);printf("imin = %d imax = %d\n", imin, imax);printf("beta = %d it = %d\n", beta, it);*/    if (lsame_(cmach, "E")) {	rmach = eps;    } else if (lsame_(cmach, "S")) {	rmach = sfmin;    } else if (lsame_(cmach, "B")) {	rmach = base;    } else if (lsame_(cmach, "P")) {	rmach = prec;    } else if (lsame_(cmach, "N")) {	rmach = t;    } else if (lsame_(cmach, "R")) {	rmach = rnd;    } else if (lsame_(cmach, "M")) {	rmach = emin;    } else if (lsame_(cmach, "U")) {	rmach = rmin;    } else if (lsame_(cmach, "L")) {	rmach = emax;    } else if (lsame_(cmach, "O")) {	rmach = rmax;    }    ret_val = rmach;    return ret_val;/*     End of SLAMCH */} /* slamch_ */