LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
slamch.f
Go to the documentation of this file.
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 *> \ingroup auxOTHERauxiliary
65 *
66 * =====================================================================
67  REAL function slamch( cmach )
68 *
69 * -- LAPACK auxiliary routine --
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 *
170 * -- LAPACK auxiliary routine --
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 ************************************************************************
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
real function slamc3(A, B)
SLAMC3
Definition: slamch.f:169
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:68