LAPACK  3.8.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 *> Specifies the value to be returned by SLAMCH:
32 *> = 'E' or 'e', SLAMCH := eps
33 *> = 'S' or 's , SLAMCH := sfmin
34 *> = 'B' or 'b', SLAMCH := base
35 *> = 'P' or 'p', SLAMCH := eps*base
36 *> = 'N' or 'n', SLAMCH := t
37 *> = 'R' or 'r', SLAMCH := rnd
38 *> = 'M' or 'm', SLAMCH := emin
39 *> = 'U' or 'u', SLAMCH := rmin
40 *> = 'L' or 'l', SLAMCH := emax
41 *> = 'O' or 'o', SLAMCH := rmax
42 *> where
43 *> eps = relative machine precision
44 *> sfmin = safe minimum, such that 1/sfmin does not overflow
45 *> base = base of the machine
46 *> prec = eps*base
47 *> t = number of (base) digits in the mantissa
48 *> rnd = 1.0 when rounding occurs in addition, 0.0 otherwise
49 *> emin = minimum exponent before (gradual) underflow
50 *> rmin = underflow threshold - base**(emin-1)
51 *> emax = largest exponent before overflow
52 *> rmax = overflow threshold - (base**emax)*(1-eps)
53 *> \endverbatim
54 *
55 * Authors:
56 * ========
57 *
58 *> \author Univ. of Tennessee
59 *> \author Univ. of California Berkeley
60 *> \author Univ. of Colorado Denver
61 *> \author NAG Ltd.
62 *
63 *> \date December 2016
64 *
65 *> \ingroup auxOTHERauxiliary
66 *
67 * =====================================================================
68  REAL FUNCTION slamch( CMACH )
69 *
70 * -- LAPACK auxiliary routine (version 3.7.0) --
71 * -- LAPACK is a software package provided by Univ. of Tennessee, --
72 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
73 * December 2016
74 *
75 * .. Scalar Arguments ..
76  CHARACTER CMACH
77 * ..
78 *
79 * =====================================================================
80 *
81 * .. Parameters ..
82  REAL ONE, ZERO
83  parameter( one = 1.0e+0, zero = 0.0e+0 )
84 * ..
85 * .. Local Scalars ..
86  REAL RND, EPS, SFMIN, SMALL, RMACH
87 * ..
88 * .. External Functions ..
89  LOGICAL LSAME
90  EXTERNAL lsame
91 * ..
92 * .. Intrinsic Functions ..
93  INTRINSIC digits, epsilon, huge, maxexponent,
94  \$ minexponent, radix, tiny
95 * ..
96 * .. Executable Statements ..
97 *
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)
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
123  rmach = radix(zero)
124  ELSE IF( lsame( cmach, 'P' ) ) THEN
125  rmach = eps * radix(zero)
126  ELSE IF( lsame( cmach, 'N' ) ) THEN
127  rmach = digits(zero)
128  ELSE IF( lsame( cmach, 'R' ) ) THEN
129  rmach = rnd
130  ELSE IF( lsame( cmach, 'M' ) ) THEN
131  rmach = minexponent(zero)
132  ELSE IF( lsame( cmach, 'U' ) ) THEN
133  rmach = tiny(zero)
134  ELSE IF( lsame( cmach, 'L' ) ) THEN
135  rmach = maxexponent(zero)
136  ELSE IF( lsame( cmach, 'O' ) ) THEN
137  rmach = huge(zero)
138  ELSE
139  rmach = zero
140  END IF
141 *
142  slamch = rmach
143  RETURN
144 *
145 * End of SLAMCH
146 *
147  END
148 ************************************************************************
149 *> \brief \b SLAMC3
150 *> \details
151 *> \b Purpose:
152 *> \verbatim
153 *> SLAMC3 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 December 2016
159 *> \ingroup auxOTHERauxiliary
160 *>
161 *> \param[in] A
162 *> \verbatim
163 *> \endverbatim
164 *>
165 *> \param[in] B
166 *> \verbatim
167 *> The values A and B.
168 *> \endverbatim
169 *>
170 *
171  REAL FUNCTION slamc3( A, B )
172 *
173 * -- LAPACK auxiliary routine (version 3.7.0) --
174 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
175 * November 2010
176 *
177 * .. Scalar Arguments ..
178  REAL A, B
179 * ..
180 * =====================================================================
181 *
182 * .. Executable Statements ..
183 *
184  slamc3 = a + b
185 *
186  RETURN
187 *
188 * End of SLAMC3
189 *
190  END
191 *
192 ************************************************************************
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
real function slamc3(A, B)
SLAMC3
Definition: slamch.f:172