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* =====================================================================
76*
77*     .. Parameters ..
78      DOUBLE PRECISION   ONE, ZERO
79      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
80*     ..
81*     .. Local Scalars ..
82      DOUBLE PRECISION   RND, EPS, SFMIN, SMALL, RMACH
83*     ..
84*     .. External Functions ..
85      LOGICAL            LSAME
86      EXTERNAL           LSAME
87*     ..
88*     .. Intrinsic Functions ..
89      INTRINSIC          DIGITS, EPSILON, HUGE, MAXEXPONENT,
90     $                   MINEXPONENT, RADIX, TINY
91*     ..
92*     .. Executable Statements ..
93*
94*
95*     Assume rounding, not chopping. Always.
96*
97      RND = ONE
98*
99      IF( ONE.EQ.RND ) THEN
100         EPS = EPSILON(ZERO) * 0.5
101      ELSE
102         EPS = EPSILON(ZERO)
103      END IF
104*
105      IF( LSAME( CMACH, 'E' ) ) THEN
106         RMACH = EPS
107      ELSE IF( LSAME( CMACH, 'S' ) ) THEN
108         SFMIN = TINY(ZERO)
109         SMALL = ONE / HUGE(ZERO)
110         IF( SMALL.GE.SFMIN ) THEN
111*
112*           Use SMALL plus a bit, to avoid the possibility of rounding
113*           causing overflow when computing  1/sfmin.
114*
115            SFMIN = SMALL*( ONE+EPS )
116         END IF
117         RMACH = SFMIN
118      ELSE IF( LSAME( CMACH, 'B' ) ) THEN
119         RMACH = RADIX(ZERO)
120      ELSE IF( LSAME( CMACH, 'P' ) ) THEN
121         RMACH = EPS * RADIX(ZERO)
122      ELSE IF( LSAME( CMACH, 'N' ) ) THEN
123         RMACH = DIGITS(ZERO)
124      ELSE IF( LSAME( CMACH, 'R' ) ) THEN
125         RMACH = RND
126      ELSE IF( LSAME( CMACH, 'M' ) ) THEN
127         RMACH = MINEXPONENT(ZERO)
128      ELSE IF( LSAME( CMACH, 'U' ) ) THEN
129         RMACH = tiny(zero)
130      ELSE IF( LSAME( CMACH, 'L' ) ) THEN
131         RMACH = MAXEXPONENT(ZERO)
132      ELSE IF( LSAME( CMACH, 'O' ) ) THEN
133         RMACH = HUGE(ZERO)
134      ELSE
135         RMACH = ZERO
136      END IF
137*
138      DLAMCH = RMACH
139      RETURN
140*
141*     End of DLAMCH
142*
143      END
144************************************************************************
145*> \brief \b DLAMC3
146*> \details
147*> \b Purpose:
148*> \verbatim
149*> DLAMC3  is intended to force  A  and  B  to be stored prior to doing
150*> the addition of  A  and  B ,  for use in situations where optimizers
151*> might hold one of these in a register.
152*> \endverbatim
153*> \author LAPACK is a software package provided by Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..
154*> \date November 2011
155*> \ingroup auxOTHERauxiliary
156*>
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 (version 3.4.0) --
171*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
172*     November 2010
173*
174*     .. Scalar Arguments ..
175      DOUBLE PRECISION   A, B
176*     ..
177* =====================================================================
178*
179*     .. Executable Statements ..
180*
181      DLAMC3 = A + B
182*
183      RETURN
184*
185*     End of DLAMC3
186*
187      END
188*
189************************************************************************
190