10
11
12
13
14
15
16
17 CHARACTER CMACH
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57 DOUBLE PRECISION ONE, ZERO
58 parameter( one = 1.0d+0, zero = 0.0d+0 )
59
60
61 LOGICAL FIRST, LRND
62 INTEGER BETA, IMAX, IMIN, IT
63 DOUBLE PRECISION BASE, EMAX, EMIN, EPS, PREC, RMACH, RMAX, RMIN,
64 $ RND, SFMIN, SMALL, T
65
66
67 LOGICAL LSAME
69
70
72
73
74 SAVE first, eps, sfmin, base, t, rnd, emin, rmin,
75 $ emax, rmax, prec
76
77
78 DATA first / .true. /
79
80
81
82 IF( first ) THEN
83 first = .false.
84 CALL dlamc2( beta, it, lrnd, eps, imin, rmin, imax, rmax )
85 base = beta
86 t = it
87 IF( lrnd ) THEN
88 rnd = one
89 eps = ( base**( 1-it ) ) / 2
90 ELSE
91 rnd = zero
92 eps = base**( 1-it )
93 END IF
94 prec = eps*base
95 emin = imin
96 emax = imax
97 sfmin = rmin
98 small = one / rmax
99 IF( small.GE.sfmin ) THEN
100
101
102
103
104 sfmin = small*( one+eps )
105 END IF
106 END IF
107
108 IF(
lsame( cmach,
'E' ) )
THEN
109 rmach = eps
110 ELSE IF(
lsame( cmach,
'S' ) )
THEN
111 rmach = sfmin
112 ELSE IF(
lsame( cmach,
'B' ) )
THEN
113 rmach = base
114 ELSE IF(
lsame( cmach,
'P' ) )
THEN
115 rmach = prec
116 ELSE IF(
lsame( cmach,
'N' ) )
THEN
117 rmach = t
118 ELSE IF(
lsame( cmach,
'R' ) )
THEN
119 rmach = rnd
120 ELSE IF(
lsame( cmach,
'M' ) )
THEN
121 rmach = emin
122 ELSE IF(
lsame( cmach,
'U' ) )
THEN
123 rmach = rmin
124 ELSE IF(
lsame( cmach,
'L' ) )
THEN
125 rmach = emax
126 ELSE IF(
lsame( cmach,
'O' ) )
THEN
127 rmach = rmax
128 END IF
129
131 RETURN
132
133
134