ground/gcs/src/libs/eigen/lapack/slamch.f

   1 *> \brief \b SLAMCH
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *  Definition:
   9 *  ===========
  10 *
  11 *      REAL             FUNCTION SLAMCH( CMACH )
  12 *
  13 *     .. Scalar Arguments ..
  14 *      CHARACTER          CMACH
  15 *     ..
  16 *
  17 *
  18 *> \par Purpose:
  19 *  =============
  20 *>
  21 *> \verbatim
  22 *>
  23 *> SLAMCH determines single precision machine parameters.
  24 *> \endverbatim
  25 *
  26 *  Arguments:
  27 *  ==========
  28 *
  29 *> \param[in] CMACH
  30 *> \verbatim
  31 *>          Specifies the value to be returned by SLAMCH:
  32 *>          = 'E' or 'e',   SLAMCH := eps
  33 *>          = 'S' or 's ,   SLAMCH := sfmin
  34 *>          = 'B' or 'b',   SLAMCH := base
  35 *>          = 'P' or 'p',   SLAMCH := eps*base
  36 *>          = 'N' or 'n',   SLAMCH := t
  37 *>          = 'R' or 'r',   SLAMCH := rnd
  38 *>          = 'M' or 'm',   SLAMCH := emin
  39 *>          = 'U' or 'u',   SLAMCH := rmin
  40 *>          = 'L' or 'l',   SLAMCH := emax
  41 *>          = 'O' or 'o',   SLAMCH := rmax
  42 *>          where
  43 *>          eps   = relative machine precision
  44 *>          sfmin = safe minimum, such that 1/sfmin does not overflow
  45 *>          base  = base of the machine
  46 *>          prec  = eps*base
  47 *>          t     = number of (base) digits in the mantissa
  48 *>          rnd   = 1.0 when rounding occurs in addition, 0.0 otherwise
  49 *>          emin  = minimum exponent before (gradual) underflow
  50 *>          rmin  = underflow threshold - base**(emin-1)
  51 *>          emax  = largest exponent before overflow
  52 *>          rmax  = overflow threshold  - (base**emax)*(1-eps)
  53 *> \endverbatim
  54 *
  55 *  Authors:
  56 *  ========
  57 *
  58 *> \author Univ. of Tennessee
  59 *> \author Univ. of California Berkeley
  60 *> \author Univ. of Colorado Denver
  61 *> \author NAG Ltd.
  62 *
  63 *> \date November 2011
  64 *
  65 *> \ingroup auxOTHERauxiliary
  66 *
  67 *  =====================================================================
  68       REAL             FUNCTION SLAMCH( CMACH )
  69 *
  70 *  -- LAPACK auxiliary routine (version 3.4.0) --
  71 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  72 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  73 *     November 2011
  74 *
  75 *     .. Scalar Arguments ..
  76       CHARACTER          CMACH
  77 *     ..
  78 *
  79 * =====================================================================
  80 *
  81 *     .. Parameters ..
  82       REAL               ONE, ZERO
  83       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
  84 *     ..
  85 *     .. Local Scalars ..
  86       REAL               RND, EPS, SFMIN, SMALL, RMACH
  87 *     ..
  88 *     .. External Functions ..
  89       LOGICAL            LSAME
  90       EXTERNAL           LSAME
  91 *     ..
  92 *     .. Intrinsic Functions ..
  93       INTRINSIC          DIGITS, EPSILON, HUGE, MAXEXPONENT,
  94      $                   MINEXPONENT, RADIX, TINY
  95 *     ..
  96 *     .. Executable Statements ..
  97 *
  98 *
  99 *     Assume rounding, not chopping. Always.
 100 *
 101       RND = ONE
 102 *
 103       IF( ONE.EQ.RND ) THEN
 104          EPS = EPSILON(ZERO) * 0.5
 105       ELSE
 106          EPS = EPSILON(ZERO)
 107       END IF
 108 *
 109       IF( LSAME( CMACH, 'E' ) ) THEN
 110          RMACH = EPS
 111       ELSE IF( LSAME( CMACH, 'S' ) ) THEN
 112          SFMIN = TINY(ZERO)
 113          SMALL = ONE / HUGE(ZERO)
 114          IF( SMALL.GE.SFMIN ) THEN
 115 *
 116 *           Use SMALL plus a bit, to avoid the possibility of rounding
 117 *           causing overflow when computing  1/sfmin.
 118 *
 119             SFMIN = SMALL*( ONE+EPS )
 120          END IF
 121          RMACH = SFMIN
 122       ELSE IF( LSAME( CMACH, 'B' ) ) THEN
 123          RMACH = RADIX(ZERO)
 124       ELSE IF( LSAME( CMACH, 'P' ) ) THEN
 125          RMACH = EPS * RADIX(ZERO)
 126       ELSE IF( LSAME( CMACH, 'N' ) ) THEN
 127          RMACH = DIGITS(ZERO)
 128       ELSE IF( LSAME( CMACH, 'R' ) ) THEN
 129          RMACH = RND
 130       ELSE IF( LSAME( CMACH, 'M' ) ) THEN
 131          RMACH = MINEXPONENT(ZERO)
 132       ELSE IF( LSAME( CMACH, 'U' ) ) THEN
 133          RMACH = tiny(zero)
 134       ELSE IF( LSAME( CMACH, 'L' ) ) THEN
 135          RMACH = MAXEXPONENT(ZERO)
 136       ELSE IF( LSAME( CMACH, 'O' ) ) THEN
 137          RMACH = HUGE(ZERO)
 138       ELSE
 139          RMACH = ZERO
 140       END IF
 141 *
 142       SLAMCH = RMACH
 143       RETURN
 144 *
 145 *     End of SLAMCH
 146 *
 147       END
 148 ************************************************************************
 149 *> \brief \b SLAMC3
 150 *> \details
 151 *> \b Purpose:
 152 *> \verbatim
 153 *> SLAMC3  is intended to force  A  and  B  to be stored prior to doing
 154 *> the addition of  A  and  B ,  for use in situations where optimizers
 155 *> might hold one of these in a register.
 156 *> \endverbatim
 157 *> \author LAPACK is a software package provided by Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..
 158 *> \date November 2011
 159 *> \ingroup auxOTHERauxiliary
 160 *>
 161 *> \param[in] A
 162 *> \verbatim
 163 *> \endverbatim
 164 *>
 165 *> \param[in] B
 166 *> \verbatim
 167 *>          The values A and B.
 168 *> \endverbatim
 169 *>
 170 *
 171       REAL             FUNCTION SLAMC3( A, B )
 172 *
 173 *  -- LAPACK auxiliary routine (version 3.4.0) --
 174 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
 175 *     November 2010
 176 *
 177 *     .. Scalar Arguments ..
 178       REAL               A, B
 179 *     ..
 180 * =====================================================================
 181 *
 182 *     .. Executable Statements ..
 183 *
 184       SLAMC3 = A + B
 185 *
 186       RETURN
 187 *
 188 *     End of SLAMC3
 189 *
 190       END
 191 *
 192 ************************************************************************