source: trunk/SOURCES/BLAS/slamch.f @ 22

Last change on this file since 22 was 22, checked in by roche, 9 years ago

Petites adaptations diverses du code pour compilation en gfortran. Ajout d un Makefile flexible a option pour choisir ifort ou gfortran.
File size: 5.1 KB
Line 
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 November 2011
64*
65*> \ingroup auxOTHERauxiliary
66*
67*  =====================================================================
68      REAL             FUNCTION SLAMCH( CMACH )
69*
70*  -- LAPACK auxiliary routine (version 3.4.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*     November 2011
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 November 2011
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.4.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************************************************************************
Note: See TracBrowser for help on using the repository browser.