*DECK C$DLOG
          IDENT  C$DLOG 
          TITLE  C$DLOG FORTRAN 5 DOUBLE-PREC. LOG
          COMMENT       FORTRAN 5 DOUBLE-PREC. LOG
**        C$DLOG - FORTRAN 5 DOUBLE-PREC. LOG 
* 
*         METHOD LET X = 2**K*W,  SQRT(.5) @ W < SQRT(2.0)
*         LOG(X) = K*LOG(2.0) + LOG(W)
*         LOG(W) IS APPROXIMATED BY A0 BY THE EQUATION
*         C1*T + C3*T**3 + C5*T**7,  T = (W-1)/(W+1)
*         (HASTINGS, APPROXIMATIONS FOR DIGITAL COMPUTERS, PRINCETON, 
*         UNIVERSITY PRESS, 1955),
*         WHICH YIELDS ABOUT 32 BINARY DIGITS OF ACCURACY.  TWO 
*         NEWTONS ITERATIONS ARE DONE TO YIELD THE DOUBLE PRECISION 
*         VALUE OF LOG(W).  THE ITERATION FORMULA FOR F(A)= E**A-X=0 IS 
*                A(N+1) = A(N) - (1 - X*E**(-A(N)). 
*         THE TERM E**(-A(0)) IS CALCULATED IN DOUBLE PRECISION USING 
*         THE SAME CODING AS E**R1 IN DEXP. 
*         LET R = X*E(-A(0)) AND T = 1.0 - R
*         R1, T1, R2, T2 DENOTE THE TWO SIGNIFICANT PARTS OF R AND T. 
*         LET A1 = A0 - T1
*         A2 = A1 - (1 - X*E**(-A0)+T1
*         = A0 - T1 - (1-R*(1 + T1**2/2 + T1**3/6)) 
*         = A0 -T1 -(1 - R - R*T1 - R*T1**2/2 - R*T1**3/6)
*         1 - R = T1 + T2 
*         R*T1 = T1 - T1**2 - T1*T2 = T1 - T1**2
*         R*T1**2/2 = T1**2/2/ - T1**3/3 - T1**2*T2/2 
*                   = T1**2/2 - T1**3/2 
*         R*T1**3/6 = T1**3/6 - T1**4/6 - T1**3*T2/6 = T1**3/6
*         WHERE THE TERMS T1*T2, T1**2*T2/2, T1**4/6, AND T1**3*T2/6
*         ARE IGNORED BECAUSE THEY ARE INSIGNIFICANT WITH RESPECT 
*         TO THE DESIRED ACCURACY OF THE FINAL RESULT.
*         A2 = A0 - T1 - T2 - T1**2 * (1/2 + T1/3)
*         WHICH IS THE ACTUAL COMPUTING FORMULA USED. 
* 
*         ACCURACY - DLOG 
*         FOR 2000 VALUES OF X UNIFORMLY DISTRIBUTED IN THE RANGE 
*         BETWEEN .5 AND 2, THE MAXIMUM OBSERVED RELATIVE ERROR WAS 
*         2.4E-2.  FOR 2000 VALUES OF X SUCH THAT X .LT. 1/2 AND
*         X .GT. 2, THE MAXIMUM OBSERVED RELATIVE ERROR WAS 2.1E-2. 
* 
*         ENTRY  (X1) - UPPER HALF OF X 
*                (X2) - LOWER HALF OF X 
*         EXIT   (X6) - UPPER HALF OF RESULT
*                (X7) - LOWER HALF OF RESULT
  
  
*         COPYRIGHT CONTROL DATA CORP 1978,1979,1980,1981,1982
* 
*         CONTROL DATA PROPRIETARY PRODUCT
  
          ENTRY  C$DLOG 
 C$DLOG   DATA   0           ENTRY/EXIT WORD
          BX6    X1 
  
*         MERGE POINT FOR C$DLOG
  
 DLG1     LX7    X2 
          SA6    TEMP 
          SB1    1
          SA7    A6+B1
          UX6    B3,X1
          SA5    SQR2C       SQRT(2)*2.47 
          SB4    -47         TRY K=-47
          IX7    X6-X5       W-SQRT(2)
          NG     X7,DLG2
  
          SB4    B4-B1       NEED K=-48 
 DLG2     PX6    B4,X6
          SA5    A5+B1       1.0
          FX0    X5-X6       -(W - 1.0) 
          NX1    X0          NORMALIZED 
          FX2    X5+X6       W + 1.0
          FX0    X1/X2       T=RATIO
          SA4    A5+B1       C1 
          SA5    A4+B1       C3 
          FX7    X0*X0       T2=T*T 
          FX1    X4*X0       C1*T 
          FX0    X7*X0       T3=T2*T
          SA4    A5+B1       C5 
          FX2    X0*X5       C3*T3
          FX0    X0*X7       T5=T3*T2 
          SA5    A4+B1       C7 
          FX3    X2+X1       SUM=C1*T1+C3*T3
          FX1    X0*X4       C5*T5
          FX0    X0*X7       T7=T5*T2 
          FX3    X3+X1       SUM+C5*T5
          FX1    X5*X0       C7*T7
          FX2    X3+X1       SUM+C7*T7
  
 DLG3     NX0    X2 
          SA2    DEXCF
          SB2    B1+B1       B2=2 
          SB3    3           LOOP COUNTER 
          SA4    A2+B2
  
 DLG4     FX6    X2*X0       H1=S1*R
          FX7    X6+X4       S1=H1+C1 
          SA4    A4+B2       NEXT C1
          NX2    X7          S1-NORMALIZED
          SB3    B3-B1       K-1
          NZ     B3,DLG4     IF MORE ITERATIONS TO GO 
  
          SX3    B0          S2=0 
          SB3    13          LOOP COUNTER 
          SA5    A4+B1       C2 
  
 DLG5     FX6    X2*X0       H1=(S1*R)U 
          DX7    X2*X0       H2=(S1*R)L 
          FX2    X4+X6       W1=(C1+H1)U
          DX4    X4+X6       W2=(C1+H1)L
          FX6    X3*X0       H3=(S2*R)U 
          NX2    X2          S1=W1,NORMALIZED 
          FX3    X4+X5       W3=(W2+C2)U
          FX7    X3+X7       W4=(W3+H2)U
          FX3    X6+X7       S2=(W4+H3)U
          SA4    A4+B2       NEW C1 
          SA5    A5+B2       NEW C2 
          SB3    B3-B1       K=K-1
          NZ     B3,DLG5     IF MORE ITERATIONS TO GO 
  
          FX6    X0*X2
          RX3    X0*X3
          FX7    X4+X6
          DX4    X4+X6
          FX6    X4+X5
          DX4    X4+X5
          DX2    X0*X2
          FX5    X6+X3
          DX6    X6+X3
          FX3    X5+X2
          DX5    X5+X2
          FX5    X5+X6
          FX5    X5+X4
          SA4    A6 
          BX0    -X0
          SA2    A4+B1       LOAD D1,D2 
          UX4    B3,X4       GET N,PART OF W
          SB7    B3-B4       B7=N-K 
          PX4    B4,X4       X6=W1
          SB4    B4-48
          PX2    B4,X2       X2=W2
          FX5    X4*X5
          DX1    X4*X3
          FX6    X1+X5
          FX5    X2*X3
          DX1    X2*X7
          FX6    X6+X5
          FX3    X4*X3
          FX2    X2*X7
          FX6    X6+X1
          DX1    X4*X7
          FX7    X4*X7
          FX5    X2+X3
          DX2    X2+X3
          SA4    ONE
          FX6    X6+X2
          FX3    X1+X5
          DX5    X1+X5
          FX6    X5+X6
          FX5    X4-X7
          NX1    X5 
          DX5    X4-X7
          FX1    X5+X1
          FX4    X1-X3
          DX5    X1-X3
          NX1    X4 
          FX2    X5-X6
          SA4    HALF        S13=.5 
          SA5    A4+B1       LOAD .33333333 
          FX3    X1*X1       S15=T1*T1
          FX5    X1*X5       S16=T1*(.333)
          FX4    X4+X5       S17=S13+S16
          FX5    X3*X4       S18=S15*S17
          FX3    X0-X1       V1=(Y0-T1)U
          DX6    X0-X1       V2=(Y0-T)L 
          SX0    B7          J=N-K
          PX1    X0 
          FX7    X6-X2       V3=(V2-T2)U
          FX6    X7-X5       V4=(V3-S18)U 
          NX0    X1          NORMALIZE J. 
          SA4    DEXC1       LOGE(2.)-U 
          SA5    A4+B1       LOGE(2.)-MIDDLE
          NX3    X3 
          FX1    X0*X4       K*M1 
          FX7    X0*X5       K*M2 
          SA4    DLOL        M3 
          FX2    X1+X3
          NX6    X6 
          FX0    X0*X4       K*M3 
          DX1    X1+X3
          FX5    X6+X7
          NX2    X2 
          DX6    X6+X7
          FX4    X1+X5
          DX1    X1+X5
          NX4    X4 
          FX0    X6+X0
          FX1    X0+X1
          FX0    X2+X4
          DX2    X2+X4
          NX0    X0 
          RX1    X2+X1
          FX6    X0+X1
          DX7    X0+X1
          EQ     C$DLOG 
  
*         CONSTANTS 
  
 TEMP     BSSZ   2
 HALF     DATA   .5 
 ONE3     DATA   .33333333333333
 D2QRL    DATA   17205520236314774736B
 DEXL2    DATA   17205612507312256030B
 DEXC1    DATA   17175427102775750000B
          DATA   16530717363257110000B
 DLOL     DATA   16077073163000771366B
 SQR2C    DATA   5520236314774736B
 ONE      DATA   1.0
 DLGC1    DATA   1.999999993734000
          DATA   .666669486638944 
          DATA   .399657811051126 
          DATA   .301005922238712 
 LOG10    DATA   17166745573052233450B
          DATA   16363431246526725260B
 DEXCF    DATA   16376256627764212414B
          DATA   15574221326731657575B
          DATA   16436572041066717637B
          DATA   15634023507373344474B
          DATA   16476563761234216570B
          DATA   15677305420243646754B
          DATA   16536234561725047371B
          DATA   15732122416633640646B
          DATA   16575411106047777136B
          DATA   15771117155561324304B
          DATA   16634367330740470433B
          DATA   16034117612420505720B
          DATA   16666563105317724671B
          DATA   16067620643643024043B
          DATA   16724477117556742232B
          DATA   16122242420572352622B
          DATA   16755616743512533071B
          DATA   16155154501673273060B
          DATA   17006400640064006400B
          DATA   16207001675212431524B
          DATA   17036400640064006400B
          DATA   16236400573436332523B
          DATA   17065540554055405540B
          DATA   16265540474036042275B
          DATA   17114210421042104210B
          DATA   16314210421046413372B
          DATA   17135252525252525252B
          DATA   16335252525263520504B
          DATA   17155252525252525252B
          DATA   16355252525252524277B
          DATA   17167777777777777777B
          DATA   16367777777777775320B
          DATA   17177777777777777777B
          DATA   16404000000000000000B
          DATA   17177777777777777777B
          DATA   16404000000000000000B
          END 
