*DECK C$RTOR
          IDENT  C$RTOR 
          TITLE  CBRTOR - REAL ** REAL
  
          MACHINE  ANY,I
          COMMENT  REAL ** REAL 
 CBRTOR   SPACE  4
**        C.RTOR - REAL ** REAL 
* 
*         INPUT 
*                X1   BASE
*                X3   EXPONENT
* 
*         OUTPUT
*                X5   RESULT
*                B3   ERROR FLAG
* 
*         SAVES 
*                B1 
* 
*         CALLS-
*                FORTRAN OBJECT LIBRARY ROUTINE *XTOY.* 
  
          ENTRY  C.RTOR 
 C.RTOR   DATA   0
          SB3    B0          ZERO ERROR FLAG
          ZR     X1,C.RTOR2 
          ZR     X3,C.RTOR1 
          NG     X1,C.RTOR3 
          RJ     =XXTOY.
          BX5    X6 
          SB1    1
          SB3    B0 
          EQ     C.RTOR 
  
 C.RTOR1  SA5    =XC.FP1     X**0 = 1 
          EQ     C.RTOR 
  
 C.RTOR2  NG     X3,C.RTOR3  0**(-X) UNDEFINED
          ZR     X3,C.RTOR3  0**0    UNDEFINED
          MX5    0           0**X = 0 
          EQ     C.RTOR 
  
 C.RTOR3  SB3    B1          ERROR
          EQ     C.RTOR 
          TITLE  XTOY. - FORTRAN 5 REAL ** REAL 
**        XTOY. - FORTRAN 5 REAL ** REAL
* 
*         ENTRY: X1 = X, BASE.
*                X3 = Y, POWER. 
* 
*         EXIT:  X6 = YY, RESULT = X**Y.
* 
*         CALLS: ALOG. TO TAKE LOG(X).
*                EXP. TO TAKE EXP(Y*LOG(X)).
* 
*         METHOD: YY = EXP(Y*LOG(X))
  
*         WRITTEN BY B. GIBBONS 10/15/77. 
  
*         COPYRIGHT CONTROL DATA CORP 1978,1979,1980,1981,1982
* 
*         CONTROL DATA PROPRIETARY PRODUCT
  
  
*         FORM Y*LOG(X) CAREFULLY, THEN EXP(Y*LOG(X)) 
  
 MULT     BSS    0
          UX5    X3,B2       CHECK FOR LARGE PRODUCT
          UX7    X6,B3
          SB0    0
          SB2    B2+B3
          PL,B2  OFLUFL 
          RX1    X3*X6       MULTIPLY Y*LOG(X)
  
 +        RJ     EXP.        EXP(Y*ALOG(X)) 
 -        VFD    30/1        IGNORE ERRORS
          OR,X6  OFLUFL      OVERFLOW 
          ZR,X6  OFLUFL      UNDERFLOW
  
 XTOY.    DATA   0           ENTRY/EXIT WORD
  
*         SAVE ARGS, TAKE LOG(X)
  
          BX6    X3          SAVE ARGS IN CASE ERROS
          BX7    X1 
          OR,X3  YBAD        IF Y INF 
          SA6    SAVEY
          ID,X3  YBAD        IF Y INDEF 
          SA7    SAVEX
*         ZR,X1  XZERO       IF X = 0 
 +        RJ     ALOG.       LOG(X) 
 -        VFD    30/1        IGNORE ERRORS
          SA3    SAVEY       Y
          DF,X6  MULT        IF X NOT INF, INDEF, OR NEG
  
*         X INFINITE, INDEFINITE, OR NEGATIVE 
  
*         VISA   ERR35,EXP.NRP,,1 
          EQ     ERROR       RESULT = +INDEF
  
*         Y INFINITE OR INDEFINITE
  
 YBAD     BSS    0
*         VISA   ERR35       RESULT = +INDEF
          BX1    X3          PUT BAD ARG IN X1
 ERROR    SX6    1777B       TO RETURN +INDEF 
          EQ     RJT
  
*         X ZERO
  
 XZERO    BSS    0
*         VISA   ERR35,EXP.0NP,,1 
          NG,X3  OFL         ZERO ** MINUS = +INF 
*         VISA   ERR35,EXP.00P,,1 
          ZR,X3  ERROR       ZERO ** ZERO = +INDEF
          BX6    X0-X0           ZERO TO THE STRICTLY POSITIVE = 0
          EQ     XTOY.
  
*         UNDERFLOW AND OVERFLOW
  
 OFLUFL   SA1    SAVEX       RESTORE ARGS 
          SA3    SAVEY
          UX2    X1,B2       B2 = EXP(X)
          SX4    B2+47       SIGN OF ALOG(X)
          BX2    X3-X4       SIGN OF Y*ALOG(X)
*         VISA   ERR35,EXP.UFL,,1 
          SX6    0
          NG,X2  RJT         UNDERFLOW = +0 
*         VISA   ERR35,EXP.OFL,,1 
 OFL      SX6    3777B
  
*         CALL SYSAID.
  
 RJT      BSS    0
*         RJT    SYSAID.
          BX6    X5 
          LX6    48          RETURN 0, +INDEF, OR +INF
          EQ     XTOY.
  
 SAVEX    BSS    1           TEMP FOR X 
 SAVEY    BSS    1           TEMP FOR Y 
          TITLE  ALOG - FORTRAN 5 NATURAL LOGARITHM 
**        ALOG - FORTRAN 5 NATURAL LOGARITHM
* 
*         ALOG WILL COMPUTE THE NATURAL LOGARITHM 
*         OF ITS ARGUMENT X.
*         Y = ALOG(X) 
*         CALL IS BY VALUE AT ENTRY POINTS ALOG.
* 
*         ENTRY CONDITIONS: 
*                AT ALOG. , 
*                (X1) = <ARGUMENT>
* 
*         EXIT CONDITIONS:  
*                (X6) = <RESULT>
* 
*         METHOD: 
*                UPON ENTRY, THE ARGUMENT X IS PUT INTO THE FORM
*                X = Y * 2 ** N, WHERE N IS AN INTEGER, AND 1. @ Y < 2. 
*                THE LOG X IS EVALUATED FROM
*                     LOG X = LOG Y + 3/4*N + (LOG 2 - 3/4) * N 
*                WHERE LOG Y IS EVALUATED AS FOLLOWS.   THE INTERVAL
*                [1., 2.) IS DIVIDED UP INTO THE SUBINTERVALS 
*         [1., 1.107), [1.107,  1.357), [1.357, 1.607), [1.607, 1.857), 
*                AND [1.857, 2.).   $CENTRE POINTS$ 1., 1.226, 1.476, 
*                1.735, AND 2. ARE CHOSEN WITHIN THESE INTERVALS. 
*                IF Y IS IN SUBINTERVAL [A, B) WITH CENTRE POINT C, 
*                LOG Y IS COMPUTED FROM 
*                     LOG Y = LOG C + LOG[(1+T)/(1-T)]
*                WHERE T = (Y - C)/(Y + C) .    LOG (1+T)/(1-T) IS THEN 
*                COMPUTED BY 2*T + C3*T**3 +C5*T**5 + C7*T**7 + C9*T**9 
*                THE COEFFICIENTS C3, C5, C7, C9 ARE CHOSEN BY TRUNCATIN
*                THE TAYLOR SERIES FOR LOG (1 + T)/(1 - T) AFTER THE
*                11TH TERM, AND TAKING A CHEBYSHEV ECONOMIZATION TO A 
*                9TH DEGREE POLYNOMIAL OVER THE LARGEST INTERVAL
*                SYMMETRIC ABOUT THE ORIGIN WHICH IS APPLICABLE.
*                THE CONSTANTS ARE C3 = .6666, C5 = .4000, C7 = .2857,
*                C9 = .2233.    IF THE ARGUMENT X IS INVALID, A 
*                A POS.INDEF. IS RETURNED.
* 
*         IMPLEMENTED UNDER THE DIRECTION OF RICK JAMES, PROJECT
*                LEADER, 1974, BY I. V. GODDARD.
  
*         COPYRIGHT CONTROL DATA CORP 1978,1979,1980,1981,1982
* 
*         CONTROL DATA PROPRIETARY PRODUCT
  
 ALOG1    RX2    X6+X1
          SB1    1           FILLER 
          RX6    X6+X2
 ALOG.    DATA   0           ENTRY/EXIT WORD
          UX2    B2,X1
          SB4    0
          AX2    48-15
 ALOG2    BSS    0
          OR     X1,ALOG5    DETECT NORMALIZED OVFL 
          SX7    X2-103334B 
          SB3    1-48 
          AX7    12 
          NO
          SA2    ALOG12+X7+4
          SB1    1
          PX6    X1,B3       [1,2)
          FX4    X6-X2       X-T
          MI     X2,ALOG3 
          FX5    X6+X2
          NX4 
 ALOG4    SX2    B2-B3
          FX1    X4/X5       (X-T)/(X+T)
          LX4    X2,B1
          IX2    X4+X2       * 3. 
          SB3    -3 
          SA3    ALOG9
          PX4    X2,B3       .75*EXPONENT.
          SA5    A2-5        LOG. 
          NX4 
          RX7    X3*X4       LOWER EXP PART.
          SA3    A3-B1       LAST OF POWER SERIES.
          FX2    X1*X1       Y**2 
          FX6    X4-X5       UPPER EXP PART + MID PART. 
          SA5    A3-1 
          FX4    X3*X2
          NX6 
          FX7    X7+X1       LOWER EXP PART + Y.
          FX3    X4+X5
          SA4    A5-B1
          FX5    X2*X3
          FX7    X7+X1       LOWER EXP PART + 2*Y.
          FX3    X5+X4
          SA5    A4-B1
          FX4    X3*X2
          FX2    X2*X1       Y**3 
          FX3    X4+X5       C3+Y**2*(...)
          FX4    X2*X3       Y**3*(C3+...)
          RX1    X7-X4       2*Y+Y**3*(...) 
          EQ     ALOG1       JUMP TO HANDLE ALOG. 
  
*         SPECIAL CASE NUMBERS JUST BELOW 2.0.
 ALOG3    SA3    A2+B1       2.0. 
          FX4    X6+X2
          SB2    B2+B1
          FX2    X4+X2       (X-T) = X-1-1. 
          NX4    X2 
          RX5    X6+X3
          ZR     X7,ALOG4 
          OR     X1,ALOG5 
          ID     X1,ALOG5 
          ZR     X1,ALOG5 
*         VISA   ERR3,ALOG11-ALOG7,,,+B4
          MI     X1,ALOG6 
          NX1 
          UX2    B2,X1
          AX2    48-15
          EQ     ALOG2
 ALOG5    BSS    0
*         VISA   ERR3,ALOG8-ALOG7,,,+B4 
 ALOG6    BSS    0
*         ZR     B4,ALOG7       (BUT B4 = 0 SINCE NO ALOG10. )
*ALOG7    RJT    SYS1ST.
          EQ     ALOG.
*         THE NEXT 12 LOCATIONS ( THE 12 BEFORE ALOG12 ) MUST BE NEGATIV
 ALOG8    DATA   6C ZERO                                              12
          DATA   -.666666666666105                                    11
          DATA   -.4000000018947                                      10
          DATA   -.2857120487                                          9
          DATA   -.22330022                                            8
 ALOG9    DATA   60623114037752136771B (LOG(2)-.75)/.75*2              7
 ALOG11   DATA   5C.LT.0                                               6
          DATA   -0                                                    5
          DATA   -17146407561431040000B LOG(1.2258...)/2               4
          DATA   -17156164261164270000B LOG(1.4758...)/2               3
          DATA   -17164321123127670000B LOG(1.7351...)/2               2
          DATA   -0                                                    1
 ALOG12   DATA   1. 
          DATA   17204716343640026622B 1.225803196513098
          DATA   17205716343666756544B 1.475803239208091
          DATA   17206741370160502702B 1.735100002271352
          DATA   -1.
          DATA   2.0
 ALOG13   DATA   17166745573052233450B
          TITLE  EXP. - FORTRAN 5 E TO POWER X
**        EXP. - FORTRAN 5 E TO POWER X 
* 
*         EXP - FORTRAN EXPONENTIAL FUNCTION EXP(X) 
*         THIS ROUTINE WILL COMPUTE EXP(X)
* 
*         ENTRY CONDITIONS. 
*                AT EXP. , (X1) = <ARGUMENT>
* 
*         EXIT CONDITIONS.
*                (X6) = <RESULT>
* 
*         METHOD. 
*                THE FORMULA EXP(X) = B ** (X/LN(B))
*                                   = (2**1/16) ** (16*X/LN(2)) 
*                                   = (2**1/16) ** (N+F)
*                IS USED TO REDUCE THE INTERVAL OF APPROXIMATION OF 
*                2**F TO (-1/16, 1/16). 
*                NOW 2**(N+F)/16 = W + 2*W*(F*(P01*F**2+P00)) 
*                                      /((F**2+Q00) - F*(P01*F**2+P00)) 
*                WHERE W = 2**N/16 BY TABLE LOOKUP. 
* 
*         REFERENCE - HART, CHENEY, LAWSON, ET AL., 
*                COMPUTER APPROXIMATIONS (NEW YORK) 1968, 
*                JOHN WILEY AND SONS, INC. PP 96-104. 
*                LIBRARY OF CONGRESS NUMBER 67-23326
*                GB 471 35630X
* 
*         IMPLEMENTED UNDER THE DIRECTION OF RICK JAMES, PROJECT
*                LEADER, 1974, BY I. V. GODDARD.
  
*         COPYRIGHT CONTROL DATA CORP 1978,1979,1980,1981,1982
* 
*         CONTROL DATA PROPRIETARY PRODUCT
  
 EXP1     SA3    A2-1        SMALLEST X.
          NX1    X1          JUST IN CASE.
          IX0    X2-X1
          IX7    X1-X3
          BX2    X0+X7
          MI     X2,EXP5     IF OUT OF RANGE. 
 EXP2     FX3    X1*X5       (X6,X2) = 96-BIT PRODUCT OF. 
          PX0    X6          UNNORMALIZED ZERO. 
          DX2    X1*X5       X*16/LN(2) UPPER.
          SA5    A4+B1       FETCH P01. 
          DX6    X3+X0       UPPER FRACTION PORTION.
          RX1    X1*X4       X1 = X*16/LN(2) LOWER. 
          FX4    X3+X0       INTEGER PORTION ('N') UNNORMALIZED.
          NX3    X6          NORMALIZED UPPER FRACTION PORTION. 
          BX0    -X0*X4      EXTRACT BIASED SIGN OF EXPONENT OF 'N'.
          RX6    X1+X2
          MX2    -4 
          AX0    58          MOVE BIASED SIGN TO BIT 0. 
          BX1    -X2*X4 
          RX7    X6+X3       FRACTION PART ('F')
          ZR     X3,EXP4
          SA3    A5+B1       Q00. 
          RX6    X7*X7       F**2 
          SA2    A3+B1       P00. 
          AX4    4
          SB2    X4-1777B+1720B 
          RX5    X6*X5       P01*F**2.
          IX4    X1-X0       ADJUST VALUE BY BIASED EXPONENT SIGN.
          SA1    TABLE+X4    FETCH APPROPRIATE POWER OF 2**1/16.
          RX2    X2+X5       P = P01*F**2 + P00.
          SB3    B2+X0
          RX7    X7*X2       F*P. 
          FX3    X3+X6       Q = F**2 + Q00.
          FX2    X3-X7       DENOMINATOR = Q - F*P. 
          FX3    X7/X2
          FX4    X1+X1       2*W. 
          FX7    X4*X3
          RX0    X1+X7       W + QUOTIENT.
          PX6    X0,B3
 EXP.     DATA   0           ENTRY/EXIT WORD
          UX2    B2,X1
          BX6    X0-X0
          SB3    1731B-1777B
          SB1    1
          SA5    CONST       16/LN(2) UPPER.
          SA4    A5+B1       16/LN(2) LOWER.
          LT     B2,B3,EXP2  IF ARGUMENT GOOD AND NOT TOO BIG.
          SA2    A5-B1       BIGGEST X. 
          EQ     B2,B3,EXP1  IF .GE. 512. 
          ID,X1  EXP7        IF INDEFINITE
          LE     B2,B0,EXP1 
 EXP5     BSS    0
*         VISA   ERR115,(=C*TOO SMALL, RESULT UNDERFLOW*-EXP3)
          MI     X1,EXP3
 EXP7     BSS    0
*         VISA   ERR30,(=C*TOO LARGE, FLOATING OVERFLOW*-EXP3)
 EXP3     BSS    0
*         RJT    SYS1ST.
          ID     X1,EXP.     RETURN +IND FOR IND. 
          MX2    11 
          AX1    60 
          LX2    -1          +INF FOR LARGE +X. 
          BX6    -X1*X2      0 FOR LARGE -X 
          EQ     EXP. 
 EXP4     SA2    EXP6 
          IX5    X1-X0       ADJUST VALUE BY BIASED EXPONENT SIGN.
          AX4    4           / 16 
          SA1    TABLE+X5    FETCH APPROPRIATE POWER OF 2**1/16.
          FX3    X2*X7
          IX6    X4+X0
          SB3    1717B-1777B
          FX7    X3*X1
          PX1    B3          DIVIDE BY 2
          RX2    X1+X7       ADD ON TWICE.
          RX3    X1+X2
          UX4    B2,X3
          SB3    X6+B2
          PX6    X3,B3
          EQ     EXP. 
  
 EXP6     DATA   .6931471805599S-4
          DATA   -675.818501045947 MINIMUM ACCEPTABLE VALUE.
          DATA    741.667483199142 MAXIMUM ACCEPTABLE VALUE.
 CONST    DATA   17400000561250731226B
          DATA   61176027741356764200B
 P01      DATA   0.5776113583180193E-1S-4 
 Q00      DATA   0.2081377119652304E2S8 
 P00      DATA   0.7213503410844819E1S4 
  
*                TABLE OF OCTAL CONSTANTS 2**(N/16) 
  
 TABLE    DATA   17204000000000000000B 2**(0)/16
          DATA   17204132530331746110B 2**(1)/16. 
          DATA   17204271270170765214B 2**(2)/16. 
          DATA   17204434172334725422B 2**(3)/16. 
          DATA   17204603376024306671B 2**(4)/16
          DATA   17204757246230110641B 2**(5)/16. 
          DATA   17205137732652330521B 2**(6)/16. 
          DATA   17205325407672441241B 2**(7)/16. 
          DATA   17205520236314774736B 2**(8)/16. 
          DATA   17205720424347654014B 2**(9)/16. 
          DATA   17206126345204252407B 2**(10)/16.
          DATA   17206342221405217605B 2**(11)/16.
          DATA   17206564237462553235B 2**(12)/16 
          DATA   17207014633673025225B 2**(13)/16.
          DATA   17207254030671756444B 2**(14)/16.
          DATA   17207522257505222207B 2**(15)/16.
          DATA   17207777777777777777B 2**(16)/16.
          END 
