Annotation of rpl/lapack/lapack/dlamch.f, revision 1.10
1.10 ! bertrand 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: * =====================================================================
1.1 bertrand 64: DOUBLE PRECISION FUNCTION DLAMCH( CMACH )
65: *
1.10 ! bertrand 66: * -- LAPACK auxiliary routine (version 3.4.0) --
1.7 bertrand 67: * -- LAPACK is a software package provided by Univ. of Tennessee, --
68: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.10 ! bertrand 69: * November 2011
1.1 bertrand 70: *
71: * .. Scalar Arguments ..
72: CHARACTER CMACH
73: * ..
74: *
1.10 ! bertrand 75: * .. Scalar Arguments ..
! 76: DOUBLE PRECISION A, B
! 77: * ..
1.1 bertrand 78: *
79: * =====================================================================
80: *
81: * .. Parameters ..
82: DOUBLE PRECISION ONE, ZERO
83: PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
84: * ..
85: * .. Local Scalars ..
1.7 bertrand 86: DOUBLE PRECISION RND, EPS, SFMIN, SMALL, RMACH
1.1 bertrand 87: * ..
88: * .. External Functions ..
89: LOGICAL LSAME
90: EXTERNAL LSAME
91: * ..
1.7 bertrand 92: * .. Intrinsic Functions ..
93: INTRINSIC DIGITS, EPSILON, HUGE, MAXEXPONENT,
94: $ MINEXPONENT, RADIX, TINY
1.1 bertrand 95: * ..
96: * .. Executable Statements ..
97: *
1.7 bertrand 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)
1.1 bertrand 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
1.7 bertrand 123: RMACH = RADIX(ZERO)
1.1 bertrand 124: ELSE IF( LSAME( CMACH, 'P' ) ) THEN
1.7 bertrand 125: RMACH = EPS * RADIX(ZERO)
1.1 bertrand 126: ELSE IF( LSAME( CMACH, 'N' ) ) THEN
1.7 bertrand 127: RMACH = DIGITS(ZERO)
1.1 bertrand 128: ELSE IF( LSAME( CMACH, 'R' ) ) THEN
129: RMACH = RND
130: ELSE IF( LSAME( CMACH, 'M' ) ) THEN
1.7 bertrand 131: RMACH = MINEXPONENT(ZERO)
1.1 bertrand 132: ELSE IF( LSAME( CMACH, 'U' ) ) THEN
1.7 bertrand 133: RMACH = tiny(zero)
1.1 bertrand 134: ELSE IF( LSAME( CMACH, 'L' ) ) THEN
1.7 bertrand 135: RMACH = MAXEXPONENT(ZERO)
1.1 bertrand 136: ELSE IF( LSAME( CMACH, 'O' ) ) THEN
1.7 bertrand 137: RMACH = HUGE(ZERO)
138: ELSE
139: RMACH = ZERO
1.1 bertrand 140: END IF
141: *
142: DLAMCH = RMACH
143: RETURN
144: *
145: * End of DLAMCH
146: *
147: END
148: ************************************************************************
1.10 ! bertrand 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: *>
1.1 bertrand 172: DOUBLE PRECISION FUNCTION DLAMC3( A, B )
173: *
1.10 ! bertrand 174: * -- LAPACK auxiliary routine (version 3.4.0) --
1.1 bertrand 175: * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
1.7 bertrand 176: * November 2010
1.1 bertrand 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: ************************************************************************
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dlamch.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack