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*     .. Scalar Arguments ..
14*     CHARACTER          CMACH
15*     ..
16*
17*
18*> \par Purpose:
19*  =============
20*>
21*> \verbatim
22*>
23*> DLAMCH determines double 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 DLAMCH:
33*>          = 'E' or 'e',   DLAMCH := eps
34*>          = 'S' or 's ,   DLAMCH := sfmin
35*>          = 'B' or 'b',   DLAMCH := base
36*>          = 'P' or 'p',   DLAMCH := eps*base
37*>          = 'N' or 'n',   DLAMCH := t
38*>          = 'R' or 'r',   DLAMCH := rnd
39*>          = 'M' or 'm',   DLAMCH := emin
40*>          = 'U' or 'u',   DLAMCH := rmin
41*>          = 'L' or 'l',   DLAMCH := emax
42*>          = 'O' or 'o',   DLAMCH := 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
65*> \ingroup auxOTHERauxiliary
66*
67*  =====================================================================
68      DOUBLE PRECISION FUNCTION DLAMCH( CMACH )
69*
70*  -- LAPACK auxiliary routine --
71*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
72*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
73*
74*     .. Scalar Arguments ..
75      CHARACTER          CMACH
76*     ..
77*
78* =====================================================================
79*
80*     .. Parameters ..
81      DOUBLE PRECISION   ONE, ZERO
82      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
83*     ..
84*     .. Local Scalars ..
85      DOUBLE PRECISION   RND, EPS, SFMIN, SMALL, RMACH
86*     ..
87*     .. External Functions ..
88      LOGICAL            LSAME
89      EXTERNAL           LSAME
90*     ..
91*     .. Intrinsic Functions ..
92      INTRINSIC          DIGITS, EPSILON, HUGE, MAXEXPONENT,
93     $                   MINEXPONENT, RADIX, TINY
94*     ..
95*     .. Executable Statements ..
96*
97*
98*     Assume rounding, not chopping. Always.
99*
100      RND = ONE
101*
102      IF( ONE.EQ.RND ) THEN
103         EPS = EPSILON(ZERO) * 0.5
104      ELSE
105         EPS = EPSILON(ZERO)
106      END IF
107*
108      IF( LSAME( CMACH, 'E' ) ) THEN
109         RMACH = EPS
110      ELSE IF( LSAME( CMACH, 'S' ) ) THEN
111         SFMIN = TINY(ZERO)
112         SMALL = ONE / HUGE(ZERO)
113         IF( SMALL.GE.SFMIN ) THEN
114*
115*           Use SMALL plus a bit, to avoid the possibility of rounding
116*           causing overflow when computing  1/sfmin.
117*
118            SFMIN = SMALL*( ONE+EPS )
119         END IF
120         RMACH = SFMIN
121      ELSE IF( LSAME( CMACH, 'B' ) ) THEN
122         RMACH = RADIX(ZERO)
123      ELSE IF( LSAME( CMACH, 'P' ) ) THEN
124         RMACH = EPS * RADIX(ZERO)
125      ELSE IF( LSAME( CMACH, 'N' ) ) THEN
126         RMACH = DIGITS(ZERO)
127      ELSE IF( LSAME( CMACH, 'R' ) ) THEN
128         RMACH = RND
129      ELSE IF( LSAME( CMACH, 'M' ) ) THEN
130         RMACH = MINEXPONENT(ZERO)
131      ELSE IF( LSAME( CMACH, 'U' ) ) THEN
132         RMACH = tiny(zero)
133      ELSE IF( LSAME( CMACH, 'L' ) ) THEN
134         RMACH = MAXEXPONENT(ZERO)
135      ELSE IF( LSAME( CMACH, 'O' ) ) THEN
136         RMACH = HUGE(ZERO)
137      ELSE
138         RMACH = ZERO
139      END IF
140*
141      DLAMCH = RMACH
142      RETURN
143*
144*     End of DLAMCH
145*
146      END
147************************************************************************
148*> \brief \b DLAMC3
149*> \details
150*> \b Purpose:
151*> \verbatim
152*> DLAMC3  is intended to force  A  and  B  to be stored prior to doing
153*> the addition of  A  and  B ,  for use in situations where optimizers
154*> might hold one of these in a register.
155*> \endverbatim
156*> \author LAPACK is a software package provided by Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..
157*> \param[in] A
158*> \verbatim
159*>          A is a DOUBLE PRECISION
160*> \endverbatim
161*>
162*> \param[in] B
163*> \verbatim
164*>          B is a DOUBLE PRECISION
165*>          The values A and B.
166*> \endverbatim
167*>
168      DOUBLE PRECISION FUNCTION DLAMC3( A, B )
169*
170*  -- LAPACK auxiliary routine --
171*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
172*
173*     .. Scalar Arguments ..
174      DOUBLE PRECISION   A, B
175*     ..
176* =====================================================================
177*
178*     .. Executable Statements ..
179*
180      DLAMC3 = A + B
181*
182      RETURN
183*
184*     End of DLAMC3
185*
186      END
187*
188************************************************************************
189