Return to dlamch.f CVS log

Up to [local] / rpl / lapack / lapack

Mise à jour de lapack vers la version 3.3.0.

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