TITLE F_ATA2
      MODULE F_ATA2
      EXPORTC F_ATA2,F_ATAN
      IMPORTC F_ZSTE,F_HANDLER
      AREADEF PROG,[PIC,READ,SHARED,CODE],DOUBLE
      AREADEF DATA,[WRITE,DATA],DOUBLE
      DEFSB   DATA
      AREA    PROG
      DCS     'ATAN2       '
F_ATAN SPRD    FP,TOS
      LPRD    FP,12(SP)
      MOVF    =1.0,F4
      BR      st
F_ATA2 SPRD    FP,TOS
      LPRD    FP,12(SP)
      MOVF    0(4(FP)),F4    ;X
st    ABSF    F4,F2          ;|X|
      ABSF    0(0(FP)),F1    ;|Y|
      MOVF    =0.0,F0        ;origin at 0
      MOVF    =0.41421356,F3 ;ROOT(2)-1 = ATAN(PI/8)
      MULF    F1,F3
      CMPF    F3,F2
      BLT     a1             ;< 67.5 degrees
      CMPF    F1,F0
      BEQ     bad            ;both args zero
      MOVF    =1.5707963,F0  ;start from 90 deg.
      DIVF    F1,F2
      NEGF    F2,F1          ;-|X/Y|
      BR      a2
a1    DIVF    F2,F1          ;|Y/X|
      CMPF    =0.41421356,F1 ;check at 22.5 degrees
      BGT     a2             ;< 22.5
      MOVF    =0.78539816,F0 ;start from 45 degrees
      MOVF    =1.0,F2
      MOVF    F2,F3
      ADDF    F1,F3
      SUBF    F2,F1
      DIVF    F3,F1          ;(Y-X)/(Y+X)
a2    MOVF    F1,F2          ;find atan(F1) <22.5 degr.
      MULF    F2,F2
      MOVF    =6.3691888,F3
      MULF    F2,F3
      ADDF    =12.659986,F3
      MULF    F3,F1
      MOVF    F2,F3
      ADDF    =10.589111,F3
      MULF    F2,F3
      ADDF    =12.659986,F3
      DIVF    F3,F1
      ADDF    F1,F0
      CMPF    =0.0,F4
      BLE     a3
      SUBF    =3.1415927,F0
      NEGF    F0,F0          ;correct for X<0
a3    CMPQW   0,2(0(FP))
      BLE     a4
      NEGF    F0,F0          ;correct for Y<0
a4    MOVF    F0,ans
      ADDR    ans,R0
      LPRD    FP,TOS
      RXP     4
bad   ADDR    mess,TOS
      CXP     F_ZSTE
      HANDLER
      CXP     F_HANDLER
txt   DCS     'arguments zero in ATAN2'
lgt   EQU     *
      AREA    DATA
ans   ALLOCD  1
mess  ADDRESS mm
mm    ADDRESS txt
      DCD     lgt-txt
      END