.TITLE .DE    COMPUTE LOG BASE 2 FOR DOUBLE ARGUMENT
/COPYRIGHT 1970, DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
       .GLOBL .DE,.AA,.AB,.AQ,.AP,.AR,.AT,.DC,.AW,.ER
/             CALLING SEQUENCE
/      JMS*   (.DE)           SUBR CALL (ARG IN FLOATING ACC)
/      NEXT   INSTRUCTION    SUBR RETURN (RESULT IN FLOATING ACC)
/
.DE    CAL    0              /ENTRY-EXIT
       LAC*   .AB            /GET SIGN WORD
       SNA!SPA               /IF .LE. ZERO
       JMP    DE01           / ERROR
       LAW    -1             /GET EXP - 1
       TAD*   .AA
       DAC    DE02           /STORE FOR INTEGER DETERMINATION
       LAC    DE06           /(1)
       DAC*   .AA            /SET ARG EXP = 1 (1 .LE. F .LT. 2)
       DAC    DE04           /SET EXP OF SQRT(2) TO 1
       JMS*   .AQ            /ADD DOUBLE
       .DSA   DE04           / (F + SQRT(2)
       ISZ    DE04           /BUMP EXP FOR 2 + SQRT(2)
       JMS*   .AP            /STORE DOUBLE
       .DSA   DE05           / (F+SQRT(2))
       JMS*   .AR            /SUBTRACT DOUBLE
       .DSA   DE04           / (F+SQRT(2)-2*SQRT(2)=F-SQRT(2))
       JMS*   .AT            /DIVIDE DOUBLE
       .DSA   DE05           / (F-SQRT(2) / F+SQRT(2))
       JMS*   .DC            /POLYNOMIAL EVALUATE ABOVE
       .DSA   DE07           /ADDR OF CALLING SEQUENCE
       JMS*   .AP            /STORE DOUBLE
       .DSA   DE05           / (RESULT TO TEMP)
       LAC    DE02           /GET INTEGER
       STL                   /ADD 0.5
       RAL                   / (INTEGER * 2)
       JMS*   .AW            /FLOAT
       LAW    -1             /EXP = EXP -1 (INTEGER/2)
       TAD*   .AA
       DAC*   .AA
       JMS*   .AQ            /ADD DOUBLE
       .DSA   DE05           / (RESULT+(INTEGER + 0.5)
       JMP*   .DE            /EXIT
DE01   JMS*   .ER            /ERROR ROUTINE
       CAL    14             /ERROR NO.
DE02   CAL    0              /INTEGER STORAGE
DE06          1           /CONSTANT 1                                LA
DE05   CAL    0              /TEMP STORAGE (1)
       CAL    0              /             (2)
       CAL    0              /             (3)
DE07          777775         /NO OF COEFF (4)
       777777; 336256; 455134	/0.4342597513D0
       000000; 223466; 040146	/0.5765843421D0
       000000; 366161; 114432	/0.9618007623D0
       000002; 270524; 354400	/2.885390073D0
DE04          1              / (X * SQRT(2)) (1) / (X = 1 OR 2
              265011         /               (2) / AND SET BY
              714640         /               (3) / PROGRAM)
       .END