Line data Source code
1 0 : double precision function pda_dpmpar(i)
2 : integer i
3 : c **********
4 : c
5 : c function pda_dpmpar
6 : c
7 : c This function provides double precision machine parameters
8 : c when the appropriate set of data statements is activated (by
9 : c removing the c from column 1) and all other data statements are
10 : c rendered inactive. Most of the parameter values were obtained
11 : c from the corresponding Bell Laboratories Port Library function.
12 : c
13 : c The function statement is
14 : c
15 : c double precision function pda_dpmpar(i)
16 : c
17 : c where
18 : c
19 : c i is an integer input variable set to 1, 2, or 3 which
20 : c selects the desired machine parameter. If the machine has
21 : c t base b digits and its smallest and largest exponents are
22 : c emin and emax, respectively, then these parameters are
23 : c
24 : c pda_dpmpar(1) = b**(1 - t), the machine precision,
25 : c
26 : c pda_dpmpar(2) = b**(emin - 1), the smallest magnitude,
27 : c
28 : c pda_dpmpar(3) = b**emax*(1 - b**(-t)), the largest magnitude.
29 : c
30 : c Argonne National Laboratory. MINPACK Project. June 1983.
31 : c Burton S. Garbow, Kenneth E. Hillstrom, Jorge J. More
32 : c
33 : c Modified 13 Jul 1995 by hme:
34 : c Comment out all code except "return". This routine now uses D1MACH
35 : c rather than its own constants. D1MACH seems to exist in a newer
36 : c version with larger variety of machines.
37 : c This routine was acquired with the VAX-11 constants enabled. My
38 : c commenting out uses C rather than the c used otherwise.
39 : c Comparing the prologues of this routine and D1MACH, it is quite
40 : c obvious that given arguments 1,2,3 correspond to 4,1,2 in D1MACH.
41 : c
42 : c Modified 13 Jul 1995 by hme:
43 : c Added an explicit declaration for function pda_d1mach.
44 : c
45 : c **********
46 : double precision pda_d1mach
47 :
48 : C integer mcheps(4)
49 : C integer minmag(4)
50 : C integer maxmag(4)
51 : C double precision dmach(3)
52 : C equivalence (dmach(1),mcheps(1))
53 : C equivalence (dmach(2),minmag(1))
54 : C equivalence (dmach(3),maxmag(1))
55 : c
56 : c Machine constants for the IBM 360/370 series,
57 : c the Amdahl 470/V6, the ICL 2900, the Itel AS/6,
58 : c the Xerox Sigma 5/7/9 and the Sel systems 85/86.
59 : c
60 : c data mcheps(1),mcheps(2) / z34100000, z00000000 /
61 : c data minmag(1),minmag(2) / z00100000, z00000000 /
62 : c data maxmag(1),maxmag(2) / z7fffffff, zffffffff /
63 : c
64 : c Machine constants for the Honeywell 600/6000 series.
65 : c
66 : c data mcheps(1),mcheps(2) / o606400000000, o000000000000 /
67 : c data minmag(1),minmag(2) / o402400000000, o000000000000 /
68 : c data maxmag(1),maxmag(2) / o376777777777, o777777777777 /
69 : c
70 : c Machine constants for the CDC 6000/7000 series.
71 : c
72 : c data mcheps(1) / 15614000000000000000b /
73 : c data mcheps(2) / 15010000000000000000b /
74 : c
75 : c data minmag(1) / 00604000000000000000b /
76 : c data minmag(2) / 00000000000000000000b /
77 : c
78 : c data maxmag(1) / 37767777777777777777b /
79 : c data maxmag(2) / 37167777777777777777b /
80 : c
81 : c Machine constants for the PDP-10 (KA processor).
82 : c
83 : c data mcheps(1),mcheps(2) / "114400000000, "000000000000 /
84 : c data minmag(1),minmag(2) / "033400000000, "000000000000 /
85 : c data maxmag(1),maxmag(2) / "377777777777, "344777777777 /
86 : c
87 : c Machine constants for the PDP-10 (KI processor).
88 : c
89 : c data mcheps(1),mcheps(2) / "104400000000, "000000000000 /
90 : c data minmag(1),minmag(2) / "000400000000, "000000000000 /
91 : c data maxmag(1),maxmag(2) / "377777777777, "377777777777 /
92 : c
93 : c Machine constants for the PDP-11.
94 : c
95 : c data mcheps(1),mcheps(2) / 9472, 0 /
96 : c data mcheps(3),mcheps(4) / 0, 0 /
97 : c
98 : c data minmag(1),minmag(2) / 128, 0 /
99 : c data minmag(3),minmag(4) / 0, 0 /
100 : c
101 : c data maxmag(1),maxmag(2) / 32767, -1 /
102 : c data maxmag(3),maxmag(4) / -1, -1 /
103 : c
104 : c Machine constants for the Burroughs 6700/7700 systems.
105 : c
106 : c data mcheps(1) / o1451000000000000 /
107 : c data mcheps(2) / o0000000000000000 /
108 : c
109 : c data minmag(1) / o1771000000000000 /
110 : c data minmag(2) / o7770000000000000 /
111 : c
112 : c data maxmag(1) / o0777777777777777 /
113 : c data maxmag(2) / o7777777777777777 /
114 : c
115 : c Machine constants for the Burroughs 5700 system.
116 : c
117 : c data mcheps(1) / o1451000000000000 /
118 : c data mcheps(2) / o0000000000000000 /
119 : c
120 : c data minmag(1) / o1771000000000000 /
121 : c data minmag(2) / o0000000000000000 /
122 : c
123 : c data maxmag(1) / o0777777777777777 /
124 : c data maxmag(2) / o0007777777777777 /
125 : c
126 : c Machine constants for the Burroughs 1700 system.
127 : c
128 : c data mcheps(1) / zcc6800000 /
129 : c data mcheps(2) / z000000000 /
130 : c
131 : c data minmag(1) / zc00800000 /
132 : c data minmag(2) / z000000000 /
133 : c
134 : c data maxmag(1) / zdffffffff /
135 : c data maxmag(2) / zfffffffff /
136 : c
137 : c Machine constants for the Univac 1100 series.
138 : c
139 : c data mcheps(1),mcheps(2) / o170640000000, o000000000000 /
140 : c data minmag(1),minmag(2) / o000040000000, o000000000000 /
141 : c data maxmag(1),maxmag(2) / o377777777777, o777777777777 /
142 : c
143 : c Machine constants for the Data General Eclipse S/200.
144 : c
145 : c Note - it may be appropriate to include the following card -
146 : c static dmach(3)
147 : c
148 : c data minmag/20k,3*0/,maxmag/77777k,3*177777k/
149 : c data mcheps/32020k,3*0/
150 : c
151 : c Machine constants for the Harris 220.
152 : c
153 : c data mcheps(1),mcheps(2) / '20000000, '00000334 /
154 : c data minmag(1),minmag(2) / '20000000, '00000201 /
155 : c data maxmag(1),maxmag(2) / '37777777, '37777577 /
156 : c
157 : c Machine constants for the Cray-1.
158 : c
159 : c data mcheps(1) / 0376424000000000000000b /
160 : c data mcheps(2) / 0000000000000000000000b /
161 : c
162 : c data minmag(1) / 0200034000000000000000b /
163 : c data minmag(2) / 0000000000000000000000b /
164 : c
165 : c data maxmag(1) / 0577777777777777777777b /
166 : c data maxmag(2) / 0000007777777777777776b /
167 : c
168 : c Machine constants for the Prime 400.
169 : c
170 : c data mcheps(1),mcheps(2) / :10000000000, :00000000123 /
171 : c data minmag(1),minmag(2) / :10000000000, :00000100000 /
172 : c data maxmag(1),maxmag(2) / :17777777777, :37777677776 /
173 : c
174 : c Machine constants for the VAX-11.
175 : c
176 : C data mcheps(1),mcheps(2) / 9472, 0 /
177 : C data minmag(1),minmag(2) / 128, 0 /
178 : C data maxmag(1),maxmag(2) / -32769, -1 /
179 : c
180 : C pda_dpmpar = dmach(i)
181 0 : if ( i .eq. 1 ) then
182 0 : pda_dpmpar = pda_d1mach(4)
183 0 : else if ( i .eq. 2 ) then
184 0 : pda_dpmpar = pda_d1mach(1)
185 0 : else if ( i .eq. 3 ) then
186 0 : pda_dpmpar = pda_d1mach(2)
187 : else
188 0 : pda_dpmpar = 0d0
189 : end if
190 0 : return
191 : c
192 : c Last card of function pda_dpmpar.
193 : c
194 : end
|
