Annotation of rpl/lapack/lapack/dlamch.f, revision 1.9
1.1 bertrand 1: DOUBLE PRECISION FUNCTION DLAMCH( CMACH )
2: *
1.7 bertrand 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
1.1 bertrand 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 ..
1.7 bertrand 56: DOUBLE PRECISION RND, EPS, SFMIN, SMALL, RMACH
1.1 bertrand 57: * ..
58: * .. External Functions ..
59: LOGICAL LSAME
60: EXTERNAL LSAME
61: * ..
1.7 bertrand 62: * .. Intrinsic Functions ..
63: INTRINSIC DIGITS, EPSILON, HUGE, MAXEXPONENT,
64: $ MINEXPONENT, RADIX, TINY
1.1 bertrand 65: * ..
66: * .. Executable Statements ..
67: *
1.7 bertrand 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)
1.1 bertrand 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
1.7 bertrand 93: RMACH = RADIX(ZERO)
1.1 bertrand 94: ELSE IF( LSAME( CMACH, 'P' ) ) THEN
1.7 bertrand 95: RMACH = EPS * RADIX(ZERO)
1.1 bertrand 96: ELSE IF( LSAME( CMACH, 'N' ) ) THEN
1.7 bertrand 97: RMACH = DIGITS(ZERO)
1.1 bertrand 98: ELSE IF( LSAME( CMACH, 'R' ) ) THEN
99: RMACH = RND
100: ELSE IF( LSAME( CMACH, 'M' ) ) THEN
1.7 bertrand 101: RMACH = MINEXPONENT(ZERO)
1.1 bertrand 102: ELSE IF( LSAME( CMACH, 'U' ) ) THEN
1.7 bertrand 103: RMACH = tiny(zero)
1.1 bertrand 104: ELSE IF( LSAME( CMACH, 'L' ) ) THEN
1.7 bertrand 105: RMACH = MAXEXPONENT(ZERO)
1.1 bertrand 106: ELSE IF( LSAME( CMACH, 'O' ) ) THEN
1.7 bertrand 107: RMACH = HUGE(ZERO)
108: ELSE
109: RMACH = ZERO
1.1 bertrand 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: *
1.7 bertrand 122: * -- LAPACK auxiliary routine (version 3.3.0) --
1.1 bertrand 123: * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
1.7 bertrand 124: * November 2010
1.1 bertrand 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: ************************************************************************
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