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 "TANH" - SINGLE PRECISION HYPERBOLIC TANGENT. 
      NAM TANH,6 24998-1X152 REV.2001 780424
* 
      ENT TANH
      EXT .ZPRV,EXP 
* 
A     EQU 0 
B     EQU 1 
* 
*     TANH TAKES THE SINGLE-PRECISION HYPERBOLIC TANGENT OF A 
*     SINGLE-PRECISION ARGUMENT.
* 
*     CALLING SEQUENCE: 
* 
*                   DLD <ARG> 
*                   JSB TANH
*                   <RETURN>   (A,B) = RESULT    NO ERROR RETURN
* 
*     METHOD:  OUTSIDE THE RANGE [-8,+8) THE APPROXIMATION
* 
*                   TANH(X) = SIGN(1.0,X) 
* 
*     IS USED.  WITHIN THIS RANGE BUT OUTSIDE THE RANGE [-0.5,+0.5) 
*     THE DEFINITION IS USED: 
* 
*                              EXP(2*X) - 1 
*                   TANH(X) = --------------
*                              EXP(2*X) + 1 
* 
*     WITHIN THE RANGE [-0.5,+0.5) SEVERE CANCELLATION OCCURS IN
*     THE ABOVE, SO THE FOLLOWING RATIONAL APPROXIMATION IS USED: 
* 
*                                            C2 
*                   TANH(X) = X * ( C1 + ----------- )
*                                         X**2 + C3 
*     WHERE:
*                   C1 = .16520923
*                   C2 = 2.0907609
*                   C3 = 2.5046337
      SKP 
*                   CHECK FOR < 0.5  OR  > 8
* 
TANH  NOP 
      JSB .ZPRV 
      DEF LIBX
      STA X         SAVE X UPPER
      SLB           CHECK [-0.5,+0.5) : EXP<0 
      JMP TANH1     YUP.
      LDA B         CHECK [-8,+8) : EXP<4 
      AND =B370 
      SZA 
      JMP TANH2     NOPE, BIG ARGUMENT
* 
*                   X IS IN [-8,-0.5) OR [0.5,8), USE EXP 
* 
      LDA X 
      ADB =D2       2*X 
      JSB EXP       EXP(2*X)
      NOP           NEVER AN ERROR
      STA X 
      STB X+1 
      FAD ONE       EXP(2X)+1 
      STA TEMP
      STB TEMP+1
      LDA X 
      LDB X+1 
      FSB ONE       EXP(2X)-1 
      FDV TEMP      TANH = (EXP(2X)-1) / (EXP(2X)+1)
LIBX  JMP TANH,I    EXIT
      DEF TANH
* 
*                   SMALL, USE RATIONAL FORM
* 
TANH1 STB X+1 
      FMP X         X**2
      FAD C3        X**2+C3 
      STA TEMP
      STB TEMP+1
      LDA C2
      LDB C2+1
      FDV TEMP      C2/(X**2+C3)
      FAD C1        C1+C2/... 
      FMP X         TANH = X*(C1+...) 
      JMP LIBX      EXIT
      SKP 
*                   BIG, USE SIGN(1.0,X)
* 
TANH2 LDA X         IF -, FORM -1.0 & EXIT
      AND =B100000
      CLB 
      CCE,SSA 
      JMP LIBX
      ERA,RAR       +, FORM +1.0 & EXIT 
      LDB =D2 
      JMP LIBX
* 
*                   LOCALS & CONSTANTS
* 
X     BSS 2         ARGUMENT
TEMP  BSS 2         TEMP
ONE   DEC 1.0 
C1    DEC .16520923 
C2    DEC 2.0907609 
C3    DEC 2.5045337 
      END 
                                                                                                                                                                                                                                                              