vendor/gonum.org/v1/gonum/lapack/internal/testdata/dsterftest/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 2011
  60 *
  61 *> \ingroup auxOTHERauxiliary
  62 *
  63 *  =====================================================================
  64       DOUBLE PRECISION FUNCTION DLAMCH( CMACH )
  65 *
  66 *  -- LAPACK auxiliary routine (version 3.4.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 2011
  70 *
  71 *     .. Scalar Arguments ..
  72       CHARACTER          CMACH
  73 *     ..
  74 *
  75 *     .. Scalar Arguments ..
  76       DOUBLE PRECISION   A, B
  77 *     ..
  78 *
  79 * =====================================================================
  80 *
  81 *     .. Parameters ..
  82       DOUBLE PRECISION   ONE, ZERO
  83       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
  84 *     ..
  85 *     .. Local Scalars ..
  86       DOUBLE PRECISION   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       DLAMCH = RMACH
 143       RETURN
 144 *
 145 *     End of DLAMCH
 146 *
 147       END
 148 ************************************************************************
 149 *> \brief \b DLAMC3
 150 *> \details
 151 *> \b Purpose:
 152 *> \verbatim
 153 *> DLAMC3  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 *>          A is a DOUBLE PRECISION
 164 *> \endverbatim
 165 *>
 166 *> \param[in] B
 167 *> \verbatim
 168 *>          B is a DOUBLE PRECISION
 169 *>          The values A and B.
 170 *> \endverbatim
 171 *>
 172       DOUBLE PRECISION FUNCTION DLAMC3( A, B )
 173 *
 174 *  -- LAPACK auxiliary routine (version 3.4.0) --
 175 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
 176 *     November 2010
 177 *
 178 *     .. Scalar Arguments ..
 179       DOUBLE PRECISION   A, B
 180 *     ..
 181 * =====================================================================
 182 *
 183 *     .. Executable Statements ..
 184 *
 185       DLAMC3 = A + B
 186 *
 187       RETURN
 188 *
 189 *     End of DLAMC3
 190 *
 191       END
 192 *
 193 ************************************************************************