TITLE   DSCM
      MODULE  DSCM
      EXPORTC DSCM
      AREADEF PROG,[PIC,READ,SHARED,CODE],BYTE
      AREA    PROG
DSCM; CALL DSCM(THETA,SIN,COS) - calculates SIN & COS in double precision
      SPRD    FP,TOS
      LPRD    FP,12(SP)
      MOVL    0(0(FP)),F0      ;Theta
;   so much for the introduction,  now the work
      MOVF    F1,TOS           ;save the sign of theta
      ABSL    F0,F0            ;|theta|
      MULL    =0.636619772367581343,F0
      ROUNDLD F0,R0            ;integral part of t'
      MOVDL   R0,F2
      SUBL    F2,F0            ;fractional part of t'
      ANDB    =3,R0            ;quadrant (0 to 3)
      MOVB    R0,R1            ;switch flag
      CMPL    =0.5,F0
      BGT     sc1
      ADDQB   1,R1             ;invert switch flag
      NEGL    F0,F0
      ADDL    =1.0,F0
sc1   MOVL    F0,F2
      MULL    F2,F2            ;t'**2
      NEGL    =26.68664569771795684,F4
      MULL    F2,F4
      ADDL    =2592.032340013512884,F4
      MULL    F2,F4
      SUBL    =34656.28854668810607,F4
      MULL    F0,F4             ;Numerator
      MOVL    F2,F0
      SUBL    =339.4590031627033410,F0
      MULL    F2,F0
      ADDL    =12373.27320145143742,F0
      MULL    F2,F0
      SUBL    =44125.75705139559888,F0
      DIVL    F0,F4              ;tan t'/2
      TBITB   =0,R1
      BFC     sc2                ;exchange sin/cos if switch set
      MOVL    F4,F0
      MULL    F4,F4
      MOVL    =1.0,F2
      SUBL    F4,F2              ;1 - t'**2
      ADDL    =1.0,F4            ;1 + t'**2
      ADDL    F0,F0              ;2t'
      BR      sc3
sc2   MOVL    F4,F2
      MULL    F4,F4
      MOVL    =1.0,F0
      SUBL    F4,F0              ;1 - t'**2
      ADDL    =1.0,F4            ;1 + t'**2
      ADDL    F2,F2              ;2t'
sc3   DIVL    F4,F2              ;sine t'
      DIVL    F4,F0              ;cosine t'
      ADDQB   -1,R0
      TBITB   =1,R0
      BFS     sc4                ;skip if sectors 0 or 3
      NEGL    F0,F0              ;change sign of cosine
sc4   CMPQD   0,TOS
      SGTB    R1                 ;TRUE if theta < 0
      CMPQB   0,R0
      SLTB    R0                 ;TRUE if sectors 2 or 3
      CMPB    R0,R1
      BEQ     sc5
      NEGL    F2,F2              ;change sign of sine
sc5  ;     jobe done,  now terminate
      MOVL    F2,0(4(FP))        ;store answers
      MOVL    F0,0(8(FP))
      LPRD    FP,TOS
      RXP     4
      END