*DECK     EXP 
          IDENT  P.EXP
          B1=1
          ENTRY  P.EXP
 EXP      SPACE  4,10 
 EXP      TITLE  EXP - EXPONENTIAL FUNCTION OF ARGUMENT.
          COMMENT PASCAL 6000 EXPONENTIAL FUNCTION ROUTINE. 
          COMMENT COPYRIGHT (C) UNIVERSITY OF MINNESOTA - 1978. 
 EXP      SPACE  4,10 
***       EXP - EXPONENTIAL FUNCTION OF ARGUMENT. 
*         L. A. LIDDIARD.    CIRCA 1970.
*         D. M. LALIBERTE.   76/08/25.
 HISTORY  SPACE  4,10 
***       EXP - EXPONENTIAL FUNCTION OF ARGUMENT. 
* 
*         ENTRY  (B1) = 1.
*                (X1) = ARGUMENT. 
* 
*         EXIT   (X6) = EXPONENTIAL FUNCTION OF ARGUMENT (E**X).
*                EXITS TO P.SABRT IF ARGUMENT OUT OF RANGE. 
* 
*         USES   A - 2, 3, 4, 5.
*                B - 3. 
*                X - ALL. 
* 
*         CALLS  P.SABRT. 
* 
*         MACROS NONE.
* 
*         ALGORITHM AND CONSTANTS COPYRIGHT (C) 1970 BY PROFESSOR 
*         KRZYSZTOF FRANKOWSKI, UNIVERSITY OF MINNESOTA.
* 
*         RELATIVE ACCURACY (I.E. ERROR/RESULT) 
*         AVERAGE = 2.2E-15 IN THE RANGE    -1.0 BY   00038  TO  2.8
*         WORST   =   8E-15 IN THE RANGE    -1.0 BY   00038  TO  2.8
* 
*         OPTIMIZED FOR CDC 6600 (OR 6700), OR CDC CYBER 74 COMPUTERS.
  
  
 EXP0     SX6    B0          RETURN ZERO
  
 P.EXP    PS                 ENTRY/EXIT 
          SA2    EXPC        LOAD LOG2(E) UPPER 
          UX7,B3 X1          GET ARGUMENT EXPONENT
          FX6    X1*X2       (ARG*LOG2(E)U)UPPER=Z UPPER + N
          SB3    B3+37       SET TO CHECK TOO LARGE,INF,IND 
          NG     B3,EXP1     IF GOOD EXPONENT 
          EQ     EXP3        IF BAD EXPONENT
  
 EXP1     AX7    77B         GET SIGN EXTENSION OF ARGUMENT 
          SA3    A2+B1       LOAD LOG2(E) LOWER 
          PX5    X7          INTEGERIZER HAS CORRECT SIGN 
          RX7    X5+X6       ENTIER(ARG*LOG2(E)+SIGN(.5,ARG)) 
          DX4    X1*X2       (ARG*LOG2(E)UPPER)LOWER
          FX3    X1*X3       (ARG*LOG2(E)LOWER)UPPER
          DX2    X6-X7       Z UPPER+N-N=Z UPPER
          NX6    X2 
          FX2    X4+X3       (ARG*LOGU)L+(ARG*LOGL)U=Z LOWER
          SB3    X7-2055B    SET EXPONENT OVERFLOW CHECK
          FX1    X6+X2       Z=Z UPPER + Z LOWER
          SA4    A3+B1       LOAD C3
          FX2    X1*X1       Z**2 
          FX6    X2*X2       Z**4 
          SA3    A4+B1       LOAD C4
          NG     B3,EXP2     IF NO EXPONENT OVERFLOW
          EQ     EXP3        IF EXPONENT OVERFLOW 
  
 EXP2     FX4    X4*X2       C3*Z**2
          SA5    A3+B1       LOAD C2
          FX0    X4+X5       C3*Z**2+C2 
          FX3    X3*X6       C4*Z**4
          SB3    X7+1717B    SET EXPONENT UNDERFLOW CHECK 
          SA5    A5+B1       LOAD C1
          FX0    X3+X0       C4*Z**4+C3*Z**2+C2=PU
          SA4    A5+B1       LOAD C0
          FX2    X5*X2       C1*Z**2
          FX6    X0*X6       PU*Z**4  (ZERO IF EXPONENT UNDERFLOW)
          FX0    X6+X2       PU*Z**4+C1*Z**2
          GE     B0,B3,EXP0  IF SMALL EXPONENT
          FX3    X0+X4       PU*Z**J+C1*Z**2+C0=POLY
          RX4    X3+X1       POLY+Z 
          UX2,B3 X4 
          SB3    X7+B3       ADD N TO EXPONENT
          FX5    X3-X1       POLY - Z 
          PX3    X2,B3
          FX6    X3/X5       EXP(ARG)=(POLY+Z)/(POLY-Z) 
          EQ     P.EXP       RETURN 
  
 EXP3     SX0    EXPA 
          ID     X1,EXP4     IF INDEFINITE ARGUMENT 
          OR     X1,EXP4     IF INFINITE ARGUMENT 
          SX0    EXPB        IF ARGUMENT TOO LARGE
 EXP4     EQ     =XP.SABRT   ABORT
  
 EXPA     DATA   C* INFINITE OR INDEF ARGUMENT OF EXP. *
  
 EXPB     DATA   C* ABS(ARG) > 740.3 IN EXP. *
  
 EXPC     DATA   17205612507312256027B  LOG2(E) UPPER 
          DATA   16407413567641777322B  LOG2(E) LOWER 
          DATA   1.05819256182728E-5
          DATA   -1.26051181801546E-7 
          DATA   -9.25068448947120E-4 
          DATA   17147311403775206256B
          DATA   2.8853900817779429E0 
 EXP      SPACE  4
          END 
