sw/os8/v3d/sources/system/dectapes/dectape3/POWERS.SB

   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