1: *> \brief \b SLAMCH
2: *
3: * =========== DOCUMENTATION ===========
4: *
5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
7: *
8: * Definition:
9: * ===========
10: *
11: * REAL FUNCTION SLAMCH( CMACH )
12: *
13: * .. Scalar Arguments ..
14: * CHARACTER CMACH
15: * ..
16: *
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
31: *> CMACH is CHARACTER*1
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: *
59: *> \author Univ. of Tennessee
60: *> \author Univ. of California Berkeley
61: *> \author Univ. of Colorado Denver
62: *> \author NAG Ltd.
63: *
64: *> \date December 2016
65: *
66: *> \ingroup auxOTHERauxiliary
67: *
68: * =====================================================================
69: REAL FUNCTION SLAMCH( CMACH )
70: *
71: * -- LAPACK auxiliary routine (version 3.7.0) --
72: * -- LAPACK is a software package provided by Univ. of Tennessee, --
73: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
74: * December 2016
75: *
76: * .. Scalar Arguments ..
77: CHARACTER CMACH
78: * ..
79: *
80: * =====================================================================
81: *
82: * .. Parameters ..
83: REAL ONE, ZERO
84: PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
85: * ..
86: * .. Local Scalars ..
87: REAL RND, EPS, SFMIN, SMALL, RMACH
88: * ..
89: * .. External Functions ..
90: LOGICAL LSAME
91: EXTERNAL LSAME
92: * ..
93: * .. Intrinsic Functions ..
94: INTRINSIC DIGITS, EPSILON, HUGE, MAXEXPONENT,
95: $ MINEXPONENT, RADIX, TINY
96: * ..
97: * .. Executable Statements ..
98: *
99: *
100: * Assume rounding, not chopping. Always.
101: *
102: RND = ONE
103: *
104: IF( ONE.EQ.RND ) THEN
105: EPS = EPSILON(ZERO) * 0.5
106: ELSE
107: EPS = EPSILON(ZERO)
108: END IF
109: *
110: IF( LSAME( CMACH, 'E' ) ) THEN
111: RMACH = EPS
112: ELSE IF( LSAME( CMACH, 'S' ) ) THEN
113: SFMIN = TINY(ZERO)
114: SMALL = ONE / HUGE(ZERO)
115: IF( SMALL.GE.SFMIN ) THEN
116: *
117: * Use SMALL plus a bit, to avoid the possibility of rounding
118: * causing overflow when computing 1/sfmin.
119: *
120: SFMIN = SMALL*( ONE+EPS )
121: END IF
122: RMACH = SFMIN
123: ELSE IF( LSAME( CMACH, 'B' ) ) THEN
124: RMACH = RADIX(ZERO)
125: ELSE IF( LSAME( CMACH, 'P' ) ) THEN
126: RMACH = EPS * RADIX(ZERO)
127: ELSE IF( LSAME( CMACH, 'N' ) ) THEN
128: RMACH = DIGITS(ZERO)
129: ELSE IF( LSAME( CMACH, 'R' ) ) THEN
130: RMACH = RND
131: ELSE IF( LSAME( CMACH, 'M' ) ) THEN
132: RMACH = MINEXPONENT(ZERO)
133: ELSE IF( LSAME( CMACH, 'U' ) ) THEN
134: RMACH = tiny(zero)
135: ELSE IF( LSAME( CMACH, 'L' ) ) THEN
136: RMACH = MAXEXPONENT(ZERO)
137: ELSE IF( LSAME( CMACH, 'O' ) ) THEN
138: RMACH = HUGE(ZERO)
139: ELSE
140: RMACH = ZERO
141: END IF
142: *
143: SLAMCH = RMACH
144: RETURN
145: *
146: * End of SLAMCH
147: *
148: END
149: ************************************************************************
150: *> \brief \b SLAMC3
151: *> \details
152: *> \b Purpose:
153: *> \verbatim
154: *> SLAMC3 is intended to force A and B to be stored prior to doing
155: *> the addition of A and B , for use in situations where optimizers
156: *> might hold one of these in a register.
157: *> \endverbatim
158: *> \author LAPACK is a software package provided by Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..
159: *> \date December 2016
160: *> \ingroup auxOTHERauxiliary
161: *>
162: *> \param[in] A
163: *> \verbatim
164: *> \endverbatim
165: *>
166: *> \param[in] B
167: *> \verbatim
168: *> The values A and B.
169: *> \endverbatim
170: *>
171: *
172: REAL FUNCTION SLAMC3( A, B )
173: *
174: * -- LAPACK auxiliary routine (version 3.7.0) --
175: * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
176: * November 2010
177: *
178: * .. Scalar Arguments ..
179: REAL A, B
180: * ..
181: * =====================================================================
182: *
183: * .. Executable Statements ..
184: *
185: SLAMC3 = A + B
186: *
187: RETURN
188: *
189: * End of SLAMC3
190: *
191: END
192: *
193: ************************************************************************
CVSweb interface <joel.bertrand@systella.fr>