vendor/gonum.org/v1/gonum/lapack/internal/testdata/netlib/dlamch.f

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