| 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 |