ASMB,L,R,C
* 
*  **************************************************************** 
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS      * 
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,       * 
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * 
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.        * 
*  **************************************************************** 
* 
*   NAME: PART OF MATH LIBRARY
*   SOURCE:  24998-18XXX  SEE NAM FOR LAST THREE DIGITS 
*   RELOC: PART OF 24998-12001
*   PGMR: BG & JTS
* 
      HED "ALOG" - SINGLE PRECISION NATURAL LOGARITHM.
      NAM ALOG,6 24998-1X162 REV.2001 780424
* 
      ENT ALOG,LN 
      EXT .ZPRV,.FLUN,FLOAT 
* 
A     EQU 0 
B     EQU 1 
* 
*     ALOG TAKES THE SINGLE-PRECISION NATURAL LOGARITHM OF A
*     SINGLE-PRECISION ARGUMENT.
* 
*     CALLING SEQUENCE: 
* 
*                   DLD <ARG> 
*                   JSB ALOG
*                   <ERROR RETURN>    (A,B) = ASCII "02UN"
*                   <NORMAL RETURN>   (A,B) = RESULT
* 
*     THE ERROR RETURN IS TAKEN IF (A,B) <= 0 . 
* 
*     METHOD:  THE IDENTITY 
* 
*                   ALOG(X) = LN(2) * (N + LOG2(X/2**N) ) 
* 
*     IS USED TO REDUCE THE COMPUTATION TO EVALUATING LOG2(Y) ON
*     [.707,1.414] .  THIS FUNCTION IS APPROXIMATED BY: 
* 
*                                  C2 
*                   Z * ( C1 + ----------- )
*                               C3 + Z**2 
*     WHERE:
*                   Z = (Y-1)/(Y+1) 
*                   C1 = 1.29061344 
*                   C2 = -2.6444261 
*                   C3 = -1.6581795 
      SKP 
*                   ERROR CHECKING AND RANGE REDUCTION. 
* 
ALOG  NOP 
LN    EQU ALOG      FOR ALGOL.
      JSB .ZPRV     FOR SHARING.
      DEF LIBX
      SSA,RSS       TEST FOR X <= 0 
      CLE,SZA,RSS   (E=0) 
      JMP ERROR     YES, ERROR
      ISZ ALOG      NO, SET NORMAL RETURN 
      STA Y         SCALE: UPPER WORD UNCHANGED 
      ADA =B-55202  E=1 IFF MANTISSA IN [.707,1)
      JSB .FLUN     SCALE TO [.5,1) 
      SEZ,RSS       IF IN [.5,.707), THEN:
      ADB TWO       DOUBLE Y, AND 
      SEZ,RSS 
      ADA =D-1      DECR N .
      STB Y+1 
      JSB FLOAT     SAVE SCALE FACTOR (N) IN FLOATING 
      STA FLTN
      STB FLTN+1
* 
*                   EVALUATE LOG2(Y)
* 
      LDA Y         FORM Z = (Y-1)/(Y+1)
      LDB Y+1 
      FAD ONE       Y+1 
      STA TEMP
      STB TEMP+1
      LDA Y 
      LDB Y+1 
      FSB ONE       Y-1 
      FDV TEMP      Z 
      STA Y 
      STB Y+1 
      FMP Y         Z**2
      FAD C3        C3+Z**2 
      STA TEMP
      STB TEMP+1
      LDA C2
      LDB C2+1
      FDV TEMP      C2/...
      FAD C1        C1+C2/... 
      FMP Y         LOG2(Y) = Z * (C1+C2/(C3+Z**2)) 
      SKP 
*                   UNDO RANGE REDUCTION
* 
      FAD FLTN      N+LOG2(Y) 
      FMP LOG2      ALOG(X) = LN(2) * (N+LOG2(Y)) 
LIBX  JMP ALOG,I    EXIT
      DEF ALOG
* 
*                   ERROR PROCESSING
* 
ERROR LDA =A02      RETURN (A,B) = ASCII "02UN" 
      LDB =AUN
      JMP LIBX
* 
*                   LOCALS & CONSTANTS. 
* 
Y     BSS 2         SCALED ARG
FLTN  BSS 2         FLOAT(N), SCALE FACTOR
TEMP  BSS 2         TEMP
ONE   OCT 040000    1.0 
TWO   OCT 000002    2 & SECOND WORD OF 1.0
LOG2  OCT 054271,006000  0.69314718 
C1    OCT 051231,064402  1.2906134432 
C2    OCT 125540,156404 -2.6444260995 
C3    OCT 112740,061402 -1.6581795496 
      END 
                            