ASMB,L,F,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 "DTAN" - DOUBLE PRECISION TRIGONOMETRIC TANGENT.
      NAM DTAN,7 24998-1X146 REV.2001 780320
* 
      ENT DTAN
      EXT .ENTR,.DFER,.TMPY,.TSUB,.TINT,.ITBL 
      EXT .XADD,.XMPY,.XDIV,XPOLY 
* 
*     DTAN TAKES THE DOUBLE-PRECISION TRIGONOMETRIC TANGENT OF A
*     DOUBLE-PRECISION NUMBER.
* 
*     CALLING SEQUENCE: 
* 
*                   JSB DTAN
*                   DEF *+3 
*                   DEF <RESULT>
*                   DEF <ARG> 
*                   <ERROR RETURN>   (A,B) = ASCII "09OR" 
*                   <NORMAL RETURN> 
* 
*     THE ERROR RETURN IS TAKEN IF THE ARGUMENT IS OUTSIDE THE
*     RANGE  [-8192*PI,+8192*PI) .
* 
*     METHOD:  THE ARGUMENT IS MULTIPLIED BY 4/PI AND THE NEAREST 
*     EVEN INTEGER IS SUBTRACTED, REDUCING THE PROBLEM TO EVALUATION
*     OF TAN(X*PI/4) ON [-1,1] BY THE FOLLOWING IDENTITIES: 
* 
*                   TAN(X) = TAN(X-N*PI)
*                   TAN(X*4/PI) = TAN(X*4/PI-4*N) 
*                   TAN(X) = -1.0 / TAN(X-PI/2) 
*                   TAN(X*4/PI) = -1.0 / TAN(X*4/PI-2)
* 
*     SO THAT THE UPPER BITS OF THE EVEN INTEGER MAY BE IGNORED 
*     (AS MULTIPLES OF 4) AND BIT 1, IF SET, REQUIRES THAT THE
*     RESULT BE NEGATED AND INVERTED. 
* 
*     THE FOLLOWING APPROXIMATION IS USED ON THE REDUCED RANGE: 
* 
*                                  C1 
*           TAN(X*PI/4) = X * ( -------- + C3+XSQ*(C4+XSQ*(C5+XSQ*C6)) )
*                                C2+XSQ 
*     WHERE:
*                   C1 = -.254660667110D+01 
*                   C2 = -.400002835440D+01 
*                   C3 =  .148751008558D+00 
*                   C4 =  .233036398271D-02 
*                   C5 =  .564290881573D-04 
*                   C6 =  .133098254545D-05 
      SKP 
*                   COPY ARG. 
* 
RESLT DEF *-* 
ARG   DEF *-* 
DTAN  NOP 
      JSB .ENTR     COPY ADDRESSES. 
      DEF RESLT 
      JSB .DFER     COPY ARG
      DEF X 
      DEF ARG,I 
* 
*                   RANGE REDUCE. 
* 
      LDA X+2       EXTEND TO 4-WORD
      AND =B377 
      STA X+3 
      XOR X+2 
      STA X+2 
      JSB .TMPY     X*4/PI
      DEF X 
      DEF X 
      DEF .4PI
      JSB .TINT     IFIX(X*4/PI)
      DEF X 
      SSA,RSS       FIND NEAREST EVEN INTEGER 
      INA 
      SOC           TOO BIG ? 
      JMP ERROR     YES, ERROR. 
      ISZ DTAN      NO, SKIP ERROR RETURN.
      ERA,CLE,ELA   CLEAR BIT 0 
      STA N 
      JSB .ITBL     FLOAT IT
      DEF XSQ 
      JSB .TSUB     X*4/PI-N
      DEF X 
      DEF X 
      DEF XSQ 
      LDA X+2       SHORTEN TO 3-WORD 
      AND =B177400
      STA X+2 
      LDA X+3 
      AND =B377 
      IOR X+2 
      STA X+2 
      SKP 
*                   EVALUATE TANGENT OF REDUCED ARG.
* 
      JSB .XMPY     X**2
      DEF XSQ 
      DEF X 
      DEF X 
      JSB XPOLY     C3+XSQ*(C4+XSQ*(C5+XSQ*C6)) 
      DEF *+5 
      DEF TEMP
      DEF K4
      DEF XSQ 
      DEF C6
      JSB .XADD     C2+XSQ
      DEF XSQ 
      DEF C2
      DEF XSQ 
      JSB .XDIV     C1/(C2+XSQ) 
      DEF XSQ 
      DEF C1
      DEF XSQ 
      JSB .XADD     C1/(C2+XSQ) + C3+...
      DEF TEMP
      DEF XSQ 
      DEF TEMP
      JSB .XMPY     X * (C1/...)
      DEF RESLT,I 
      DEF X 
      DEF TEMP
* 
*                   IF ODD NUMBER OF PI/2, INVERT & NEGATE. 
* 
      LDA N         I.E., CHECK BIT 1ULT. 
      RAR,SLA 
      JMP *+2       SET, DO -1.0/RESULT 
      JMP DTAN,I    CLEAR, EXIT.
      JSB .XDIV     RESULT _ -1.0 / RESULT
      DEF RESLT,I 
      DEF MONE
      DEF RESLT,I 
      JMP DTAN,I    EXIT
* 
*                   ERROR PROCESSING. 
* 
ERROR LDA =A09      (A,B) = ASCII "09OR"
      LDB =AOR
      JMP DTAN,I    TAKE ERROR EXIT.
      SKP 
*                   LOCALS & CONSTANTS. 
* 
X     BSS 4         ARG & REDUCED ARG 
XSQ   BSS 4         X**2
TEMP  BSS 4         TEMP
N     BSS 1         2 * NUMBER OF PI/2 SUBTRACTED 
K4    DEC 4         LENGTH OF POLY TO XPOLY 
MONE  DEX -1.0
C1    OCT 127202,031271,175404
C2    OCT 137777,161104,126406
C6    OCT 054522,015443,167733
C5    OCT 073127,021322,056345
C4    OCT 046134,101213,174761
C3    OCT 046051,013632,000775
.4PI  OCT 050574,140667,023442,005402 
      END 
                                                                                                                                                                                                                            