MoDeNa  1.0
Software framework facilitating sequential multi-scale modelling
dlamch.f
1 *> \brief \b DLAMCH
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 * Definition:
9 * ===========
10 *
11 * DOUBLE PRECISION FUNCTION DLAMCH( CMACH )
12 *
13 *
14 *> \par Purpose:
15 * =============
16 *>
17 *> \verbatim
18 *>
19 *> DLAMCH determines double precision machine parameters.
20 *> \endverbatim
21 *
22 * Arguments:
23 * ==========
24 *
25 *> \param[in] CMACH
26 *> \verbatim
27 *> Specifies the value to be returned by DLAMCH:
28 *> = 'E' or 'e', DLAMCH := eps
29 *> = 'S' or 's , DLAMCH := sfmin
30 *> = 'B' or 'b', DLAMCH := base
31 *> = 'P' or 'p', DLAMCH := eps*base
32 *> = 'N' or 'n', DLAMCH := t
33 *> = 'R' or 'r', DLAMCH := rnd
34 *> = 'M' or 'm', DLAMCH := emin
35 *> = 'U' or 'u', DLAMCH := rmin
36 *> = 'L' or 'l', DLAMCH := emax
37 *> = 'O' or 'o', DLAMCH := rmax
38 *> where
39 *> eps = relative machine precision
40 *> sfmin = safe minimum, such that 1/sfmin does not overflow
41 *> base = base of the machine
42 *> prec = eps*base
43 *> t = number of (base) digits in the mantissa
44 *> rnd = 1.0 when rounding occurs in addition, 0.0 otherwise
45 *> emin = minimum exponent before (gradual) underflow
46 *> rmin = underflow threshold - base**(emin-1)
47 *> emax = largest exponent before overflow
48 *> rmax = overflow threshold - (base**emax)*(1-eps)
49 *> \endverbatim
50 *
51 * Authors:
52 * ========
53 *
54 *> \author Univ. of Tennessee
55 *> \author Univ. of California Berkeley
56 *> \author Univ. of Colorado Denver
57 *> \author NAG Ltd.
58 *
59 *> \date November 2011
60 *
61 *> \ingroup auxOTHERauxiliary
62 *
63 * =====================================================================
64  DOUBLE PRECISION FUNCTION dlamch( CMACH )
65 *
66 * -- LAPACK auxiliary routine (version 3.4.0) --
67 * -- LAPACK is a software package provided by Univ. of Tennessee, --
68 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
69 * November 2011
70 *
71 * .. Scalar Arguments ..
72  CHARACTER cmach
73 * ..
74 *
75 * .. Scalar Arguments ..
76  DOUBLE PRECISION a, b
77 * ..
78 *
79 * =====================================================================
80 *
81 * .. Parameters ..
82  DOUBLE PRECISION one, zero
83  parameter( one = 1.0d+0, zero = 0.0d+0 )
84 * ..
85 * .. Local Scalars ..
86  DOUBLE PRECISION 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  dlamch = rmach
143  RETURN
144 *
145 * End of DLAMCH
146 *
147  END
148 ************************************************************************
149 *> \brief \b DLAMC3
150 *> \details
151 *> \b Purpose:
152 *> \verbatim
153 *> DLAMC3 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 November 2011
159 *> \ingroup auxOTHERauxiliary
160 *>
161 *> \param[in] A
162 *> \verbatim
163 *> A is a DOUBLE PRECISION
164 *> \endverbatim
165 *>
166 *> \param[in] B
167 *> \verbatim
168 *> B is a DOUBLE PRECISION
169 *> The values A and B.
170 *> \endverbatim
171 *>
172  DOUBLE PRECISION FUNCTION dlamc3( A, B )
173 *
174 * -- LAPACK auxiliary routine (version 3.4.0) --
175 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
176 * November 2010
177 *
178 * .. Scalar Arguments ..
179  DOUBLE PRECISION a, b
180 * ..
181 * =====================================================================
182 *
183 * .. Executable Statements ..
184 *
185  dlamc3 = a + b
186 *
187  RETURN
188 *
189 * End of DLAMC3
190 *
191  END
192 *
193 ************************************************************************