Commit | Line | Data |
---|---|---|
7af5ad59 PH |
1 | /POWERS SUBROUTINE OS8 FORTRAN II LIBRARY |
2 | / | |
3 | / | |
4 | / | |
5 | / | |
6 | / | |
7 | / | |
8 | / | |
9 | / | |
10 | / | |
11 | /COPYRIGHT (C) 1974,1977 BY DIGITAL EQUIPMENT CORPORATION | |
12 | / | |
13 | / | |
14 | / | |
15 | / | |
16 | / | |
17 | / | |
18 | / | |
19 | / | |
20 | / | |
21 | / | |
22 | /THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE | |
23 | /AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT | |
24 | /CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY | |
25 | /FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL. | |
26 | / | |
27 | /THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER | |
28 | /UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED | |
29 | /(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH | |
30 | /SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. | |
31 | / | |
32 | /DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE | |
33 | /OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY | |
34 | /DIGITAL. | |
35 | / | |
36 | / | |
37 | / | |
38 | / | |
39 | / | |
40 | / | |
41 | / | |
42 | / | |
43 | / | |
44 | / | |
45 | / | |
46 | \f/ VERSION 5A | |
47 | / VERSION NUMBER IS AVAILABLE AT ENTRY POINTS | |
48 | ENTRY IFPOW / INTEGER TO FLOATING POWER | |
49 | ENTRY FFPOW / FLOATING TO FLOATING POWER | |
50 | ENTRY EXP / E TO A POWER | |
51 | ENTRY ALOG / NATURAL LOGARITHM | |
52 | / | |
53 | / | |
54 | DUMMY LXP | |
55 | OPDEF JMSKP 4000 | |
56 | / | |
57 | / INTERNAL SUBROUTINE POL | |
58 | / | |
59 | / COMPUTES N TERMS OF POLYNOMIAL (NO CONSTANT TERM) | |
60 | / N IN AC ... X IN FLOATING AC | |
61 | / COEFFICIENTS START IN LOCATION WHOSE ADDRESS FOLLOWS JMS TO POL | |
62 | / | |
63 | POL2, BLOCK 1 | |
64 | POL, BLOCK 1 | |
65 | CIA | |
66 | DCA POL2 | |
67 | CALL 1,STO | |
68 | ARG X | |
69 | TAD I POL | |
70 | INC POL | |
71 | / DCA ARG1# /THIS CODE PROBABLY EXTRANEOUS | |
72 | / SKP | |
73 | ARG2, DCA ARG1# | |
74 | CALL 1,FAD | |
75 | ARG1, ARG EXS / ADDRESS STORED HERE | |
76 | CALL 1,FMP | |
77 | ARG X | |
78 | ISZ POL2 | |
79 | JMP POL1 | |
80 | JMP I POL | |
81 | POL1, TAD ARG1# | |
82 | TAD (3 | |
83 | JMP ARG2 | |
84 | ||
85 | CPAGE 17 / CANT BREAK UP THIS TABLE | |
86 | EXS, 1464 /7.9608942E-9 CONSTANTS FOR EXP | |
87 | 2142 | |
88 | 1421 | |
89 | 1545 /6.3578287E-7 | |
90 | 2525 | |
91 | 2525 | |
92 | 1625 /4.0690103E-5 | |
93 | 2525 | |
94 | 2525 | |
95 | 1704 /1.9531250E-3 | |
96 | 0000 | |
97 | 0000 | |
98 | 1754 /6.25E-2 | |
99 | 0000 | |
100 | 0000 | |
101 | CPAGE 3 | |
102 | ONE, 2014 | |
103 | 0000 | |
104 | 0000 | |
105 | CPAGE 30 | |
106 | COF, 5716 /-6.4535442E-3 CONSTANTS FOR LOGS | |
107 | 4674 | |
108 | 1006 | |
109 | 1744 /3.6088494E-2 | |
110 | 4750 | |
111 | 6073 | |
112 | 5756 /-9.5329390E-2 | |
113 | 0636 | |
114 | 0162 | |
115 | 1765 /1.6765407E-1 | |
116 | 2726 | |
117 | 6023 | |
118 | 5767 /-2.4073380E-1 | |
119 | 5501 | |
120 | 3543 | |
121 | 1775 /3.3179902E-1 | |
122 | 2360 | |
123 | 6176 | |
124 | 5777 /-4.9987412E-1 | |
125 | 7767 | |
126 | 6001 | |
127 | 2007 /9.9999643E-1 | |
128 | 7777 | |
129 | 7041 | |
130 | CPAGE 3 | |
131 | ER16, 2014 /1.0644944 | |
132 | 2040 | |
133 | 5326 | |
134 | CPAGE 3 | |
135 | LN2, 1755 /8.6643397E-2 | |
136 | 4271 | |
137 | 0300 | |
138 | ||
139 | X, BLOCK 3 | |
140 | Y, BLOCK 3 | |
141 | \f | |
142 | / | |
143 | / ALOG - NATURAL LOGARITHM | |
144 | / | |
145 | / ALOG(X)=N*ALOG(2)+ALOG(M) WHERE 1/2 OR EQUAL TO M | |
146 | / ALOG(M)=ALTERNATING SERIES (K**I)/I WHERE K=2M-1 AND M AS ABOVE | |
147 | / | |
148 | CPAGE 4 | |
149 | LGER, 0114 / "ALOG" ERROR AT LOC XXXXX | |
150 | 1707 | |
151 | ALOG, BLOCK 1 | |
152 | 5 / ENTRY POINT | |
153 | TAD ALOG | |
154 | DCA TEM | |
155 | TAD ALOG# | |
156 | DCA TEM# | |
157 | CALL 1,IFAD | |
158 | TEM, ARG 0 | |
159 | INC ALOG# | |
160 | INC ALOG# | |
161 | TAD ACH / GET EXPONENT | |
162 | SPA SNA | |
163 | JMP LGERR /LOG OF X<=0 - ERROR | |
164 | AND (3770 | |
165 | TAD (5770 / -2000 | |
166 | DCA TEM / N INTO TEM | |
167 | TAD ACH / GET M WITHOUT SIGN | |
168 | AND (7 | |
169 | TAD (2010 / 2M | |
170 | DCA ACH | |
171 | CALL 1,FSB / 2M-1 | |
172 | ARG ONE | |
173 | TAD (D8 / 8 TERMS OF SERIES | |
174 | JMS POL | |
175 | COF | |
176 | CALL 1,STO / ALOG(M) INTO Y | |
177 | ARG Y | |
178 | TAD TEM / GET N | |
179 | CALL 0,FLOT / FLOAT IT | |
180 | CALL 1,FMP / N *ALOG(2) | |
181 | ARG LN2 | |
182 | CALL 1,FAD / N *ALOG(2) ALOG(M)(ALOG(X) | |
183 | ARG Y | |
184 | RETRN ALOG / EXIT | |
185 | LGERR, CALL 1,ERROR | |
186 | ARG LGER | |
187 | \f | |
188 | / | |
189 | / EXP - E TO A POWER | |
190 | / | |
191 | / E**X=SERIES (X**I)/(I!) | |
192 | / IF B=E**(1/16) AND X IS BETWEEN -1 AND 1 THEN | |
193 | / B**X=1 SUMA(I)*(X**I) FOR I FROM I=1 TO I=5 | |
194 | / WHERE A(I)(1/((I!)*16**2)) | |
195 | / | |
196 | CPAGE 4 | |
197 | EXPER, 4530 | |
198 | 2040 | |
199 | EXP, BLOCK 1 | |
200 | 5 / ENTRY POINT | |
201 | TAD EXP | |
202 | DCA XT | |
203 | TAD EXP# | |
204 | DCA XT# | |
205 | INC EXP# | |
206 | INC EXP# | |
207 | CALL 1,IFAD | |
208 | XT, ARG 0 | |
209 | CLA CLL CMA RAR | |
210 | AND ACH | |
211 | TAD (-2075 | |
212 | SMA CLA | |
213 | TAD ACM | |
214 | CLL | |
215 | TAD (-4271 /TEST FOR FLTG. AC <88.2 | |
216 | SZL CLA | |
217 | JMP EXPERR | |
218 | TAD ACH | |
219 | SZA | |
220 | TAD (40 / X*16 | |
221 | DCA ACH | |
222 | CALL 1,STO / Y=16X | |
223 | ARG Y | |
224 | CALL 1,FAD / EXPRESS Y AS INTEGER N AND FRACTION F | |
225 | ARG Y | |
226 | CALL 0,FIX / GET N | |
227 | SMA | |
228 | IAC | |
229 | DCA ALOG / ALOG=N | |
230 | TAD ALOG / GET F | |
231 | CIA | |
232 | CALL 0,FLOT | |
233 | CALL 1,FAD | |
234 | ARG Y | |
235 | TAD (5 / 5 TERMS OF SERIES | |
236 | JMS POL | |
237 | EXS | |
238 | CALL 1,FAD / PLUS 1 | |
239 | ARG ONE | |
240 | CALL 1,STO / GIVES B**F | |
241 | ARG Y | |
242 | CALL 1,FAD / GET B | |
243 | ARG ER16 | |
244 | CALL 1,FIPOW | |
245 | ARG ALOG | |
246 | CALL 1,FMP / B**(N+F)=(B**16X)(E**X) | |
247 | ARG Y | |
248 | RETRN EXP / EXIT | |
249 | EXPERR, CALL 1,ERROR | |
250 | ARG EXPER | |
251 | TAD ACH | |
252 | SMA CLA | |
253 | CLL CMA RAR | |
254 | DCA ACH | |
255 | DCA ACM | |
256 | DCA ACL | |
257 | RETRN EXP | |
258 | \f | |
259 | / | |
260 | / IFPOW - INTEGER TO FLOATING POWER | |
261 | / | |
262 | / JUST FLOAT BASE AND GO TO FFPOW | |
263 | / | |
264 | IFPOW, BLOCK 1 | |
265 | 5 / ENTRY POINT | |
266 | CALL 0,FLOT | |
267 | TAD IFPOW / FROM BANK | |
268 | DCA FFPOW / TO PROPER LOCATION | |
269 | TAD IFPOW# // FROM ADDRESS | |
270 | DCA FFPOW# /TO PROPER LOC | |
271 | JMP ML / SNEAK INTO ROUTINE | |
272 | ||
273 | / | |
274 | / FFPOW- FLOATING TO FLOATING POWER | |
275 | / | |
276 | / IDENTITY USED ... X**Y=EXP(Y*ALOG(X)) | |
277 | / | |
278 | CPAGE 4 | |
279 | FFPER, 4614 | |
280 | 2027 | |
281 | FFPOW, BLOCK 1 | |
282 | 5 / ENTRY POINT | |
283 | ML, TAD I FFPOW / GET CDF TO EXPONENT | |
284 | DCA LXP | |
285 | INC FFPOW# / INCREMENT TO EXPONENT ADDRESS | |
286 | TAD I FFPOW / GET EXPONENT ADDRESS | |
287 | DCA LXP# | |
288 | INC FFPOW# / INCREMENT FOR EXIT | |
289 | TAD I LXP / HIGH ORDER WORD OF EXPONENT | |
290 | SNA CLA / IS IT ZERO | |
291 | JMP FFP5 / YES ... RESULT=1 | |
292 | TAD ACH / BASE IS IN FLOATING POINT AC | |
293 | SPA | |
294 | JMP FFPERR | |
295 | SZA CLA / IF BASE EQUALS ZERO ... RESULT EQUALS ZERO | |
296 | JMP FFP1 | |
297 | RETRN FFPOW / ZERO RESULT EXIT | |
298 | FFP1, CALL 1,STO / SAVE BASE | |
299 | FFP2, ARG X | |
300 | CALL 1,ALOG | |
301 | ARG X | |
302 | CALL 1,FMP / Y*LOG(X) | |
303 | LXP, ARG 0 / ADDRESS STORED HERE | |
304 | CALL 1,STO | |
305 | ARG X | |
306 | CALL 1,EXP | |
307 | ARG X | |
308 | FFP6, RETRN FFPOW | |
309 | FFP5, CALL 0,CLEAR / ANYTHING TO ZERO POWER IS 1 | |
310 | TAD (2014 | |
311 | DCA ACH | |
312 | JMP FFP6 | |
313 | FFPERR, TAD (4000 | |
314 | DCA ACH | |
315 | CALL 1,ERROR | |
316 | ARG FFPER | |
317 | JMP FFP1 | |
318 | END | |
319 | \f |