V3FIT
dpmpar.f
1  FUNCTION dpmpar (i)
2  USE stel_kinds
3  IMPLICIT NONE
4 C-----------------------------------------------
5 C D u m m y A r g u m e n t s
6 C-----------------------------------------------
7  INTEGER :: i
8  REAL(rprec) :: dpmpar
9 C-----------------------------------------------
10 c
11 c FUNCTION dpmpar
12 c
13 c this FUNCTION provides single (double) precision machine parameters
14 c when the appropriate set of data statements is activated (by
15 c removing the c from column 1) and ALL other data statements are
16 c rendered inactive. most of the PARAMETER values were obtained
17 c from the corresponding bell laboratories port library FUNCTION.
18 c
19 c the FUNCTION statement is
20 c
21 c FUNCTION dpmpar(i)
22 c
23 c WHERE
24 c
25 c i is an integer input variable set to 1, 2, or 3 which
26 c selects the desired machine parameter. if the machine has
27 c t base b digits and its smallest and largest exponents are
28 c emin and emax, respectively, then these parameters are
29 c
30 c dpmpar(1) = b**(1 - t), the machine precision,
31 c
32 c dpmpar(2) = b**(emin - 1), the smallest magnitude,
33 c
34 c dpmpar(3) = b**emax*(1 - b**(-t)), the largest magnitude.
35 c
36 c argonne national laboratory. minpack project. march 1980.
37 c burton s. garbow, kenneth e. hillstrom, jorge j. more
38 c
39 c SINGLE PRECISION
40 c data rmach(1)/1.490116100E-8/
41 c data rmach(2)/1.4693679000E-30/
42 c data rmach(3)/1.701411800E+30/
43 c DOUBLE PRECISION - IEEE
44 c data dmach(1) /2.22044604926d-16/
45 c data dmach(2) /2.22507385852d-308/
46 c data dmach(3) /1.79769313485d+308/
47 c modified for f90 (sph, august 1997)
48 c
49  SELECT CASE(i)
50  CASE(:1)
51  dpmpar = epsilon(dpmpar) !2.22044604926e-16_dp
52  CASE(2)
53  dpmpar = tiny(dpmpar) !2.22507385852e-308_dp
54  CASE(3:)
55  dpmpar = huge(dpmpar) !1.79769313485e+308_dp
56  END SELECT
57 
58  END FUNCTION dpmpar