LAPACK 3.3.0

slamch.f

Go to the documentation of this file.
00001       REAL             FUNCTION SLAMCH( CMACH )
00002 *
00003 *  -- LAPACK auxiliary routine (version 3.3.0) --
00004 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00005 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00006 *     Based on LAPACK DLAMCH but with Fortran 95 query functions
00007 *     See: http://www.cs.utk.edu/~luszczek/lapack/lamch.html
00008 *     and  http://www.netlib.org/lapack-dev/lapack-coding/program-style.html#id2537289
00009 *     July 2010
00010 *
00011 *     .. Scalar Arguments ..
00012       CHARACTER          CMACH
00013 *     ..
00014 *
00015 *  Purpose
00016 *  =======
00017 *
00018 *  SLAMCH determines single precision machine parameters.
00019 *
00020 *  Arguments
00021 *  =========
00022 *
00023 *  CMACH   (input) CHARACTER*1
00024 *          Specifies the value to be returned by SLAMCH:
00025 *          = 'E' or 'e',   SLAMCH := eps
00026 *          = 'S' or 's ,   SLAMCH := sfmin
00027 *          = 'B' or 'b',   SLAMCH := base
00028 *          = 'P' or 'p',   SLAMCH := eps*base
00029 *          = 'N' or 'n',   SLAMCH := t
00030 *          = 'R' or 'r',   SLAMCH := rnd
00031 *          = 'M' or 'm',   SLAMCH := emin
00032 *          = 'U' or 'u',   SLAMCH := rmin
00033 *          = 'L' or 'l',   SLAMCH := emax
00034 *          = 'O' or 'o',   SLAMCH := rmax
00035 *
00036 *          where
00037 *
00038 *          eps   = relative machine precision
00039 *          sfmin = safe minimum, such that 1/sfmin does not overflow
00040 *          base  = base of the machine
00041 *          prec  = eps*base
00042 *          t     = number of (base) digits in the mantissa
00043 *          rnd   = 1.0 when rounding occurs in addition, 0.0 otherwise
00044 *          emin  = minimum exponent before (gradual) underflow
00045 *          rmin  = underflow threshold - base**(emin-1)
00046 *          emax  = largest exponent before overflow
00047 *          rmax  = overflow threshold  - (base**emax)*(1-eps)
00048 *
00049 * =====================================================================
00050 *
00051 *     .. Parameters ..
00052       REAL               ONE, ZERO
00053       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
00054 *     ..
00055 *     .. Local Scalars ..
00056       REAL               RND, EPS, SFMIN, SMALL, RMACH
00057 *     ..
00058 *     .. External Functions ..
00059       LOGICAL            LSAME
00060       EXTERNAL           LSAME
00061 *     ..
00062 *     .. Intrinsic Functions ..
00063       INTRINSIC          DIGITS, EPSILON, HUGE, MAXEXPONENT,
00064      $                   MINEXPONENT, RADIX, TINY
00065 *     ..
00066 *     .. Executable Statements ..
00067 *
00068 *
00069 *     Assume rounding, not chopping. Always.
00070 *
00071       RND = ONE
00072 *
00073       IF( ONE.EQ.RND ) THEN
00074          EPS = EPSILON(ZERO) * 0.5
00075       ELSE
00076          EPS = EPSILON(ZERO)
00077       END IF
00078 *
00079       IF( LSAME( CMACH, 'E' ) ) THEN
00080          RMACH = EPS
00081       ELSE IF( LSAME( CMACH, 'S' ) ) THEN
00082          SFMIN = TINY(ZERO)
00083          SMALL = ONE / HUGE(ZERO)
00084          IF( SMALL.GE.SFMIN ) THEN
00085 *
00086 *           Use SMALL plus a bit, to avoid the possibility of rounding
00087 *           causing overflow when computing  1/sfmin.
00088 *
00089             SFMIN = SMALL*( ONE+EPS )
00090          END IF
00091          RMACH = SFMIN
00092       ELSE IF( LSAME( CMACH, 'B' ) ) THEN
00093          RMACH = RADIX(ZERO)
00094       ELSE IF( LSAME( CMACH, 'P' ) ) THEN
00095          RMACH = EPS * RADIX(ZERO)
00096       ELSE IF( LSAME( CMACH, 'N' ) ) THEN
00097          RMACH = DIGITS(ZERO)
00098       ELSE IF( LSAME( CMACH, 'R' ) ) THEN
00099          RMACH = RND
00100       ELSE IF( LSAME( CMACH, 'M' ) ) THEN
00101          RMACH = MINEXPONENT(ZERO)
00102       ELSE IF( LSAME( CMACH, 'U' ) ) THEN
00103          RMACH = tiny(zero)
00104       ELSE IF( LSAME( CMACH, 'L' ) ) THEN
00105          RMACH = MAXEXPONENT(ZERO)
00106       ELSE IF( LSAME( CMACH, 'O' ) ) THEN
00107          RMACH = HUGE(ZERO)
00108       ELSE
00109          RMACH = ZERO
00110       END IF
00111 *
00112       SLAMCH = RMACH
00113       RETURN
00114 *
00115 *     End of SLAMCH
00116 *
00117       END
00118 ************************************************************************
00119 *
00120       REAL             FUNCTION SLAMC3( A, B )
00121 *
00122 *  -- LAPACK auxiliary routine (version 3.3.0) --
00123 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00124 *     November 2010
00125 *
00126 *     .. Scalar Arguments ..
00127       REAL               A, B
00128 *     ..
00129 *
00130 *  Purpose
00131 *  =======
00132 *
00133 *  SLAMC3  is intended to force  A  and  B  to be stored prior to doing
00134 *  the addition of  A  and  B ,  for use in situations where optimizers
00135 *  might hold one of these in a register.
00136 *
00137 *  Arguments
00138 *  =========
00139 *
00140 *  A       (input) REAL
00141 *  B       (input) REAL
00142 *          The values A and B.
00143 *
00144 * =====================================================================
00145 *
00146 *     .. Executable Statements ..
00147 *
00148       SLAMC3 = A + B
00149 *
00150       RETURN
00151 *
00152 *     End of SLAMC3
00153 *
00154       END
00155 *
00156 ************************************************************************
 All Files Functions