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