ASMB,R,L,C
      NAM CSNCS,7 24998-1X139 REV.2013 791018 
      ENT CCOS,CSIN 
      EXT .ENTR,SIN,COS,EXP,..FCM 
*********************************************************************** 
*                                                                     * 
*     NAME: CSNCS                                                     * 
*   SOURCE: 24998-18139                                               * 
*    RELOC: PART OF 24998-12002                                       * 
*     PGMR: CRG                                                       * 
*                                                                     * 
*********************************************************************** 
*                                                                     * 
*     (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.           * 
*                                                                     * 
*********************************************************************** 
* 
*     COMPLEX COSINE
* 
*     CALLING SEQUENCE:   Y=CCOS(X) 
* 
*                         JSB CCOS
*                         DEF *+3 
*                         DEF Y 
*                         DEF X 
*                         <ERROR RETURN>
*                         <NORMAL RETURN> 
* 
*********************************************************************** 
* 
CY    NOP 
CX    NOP 
* 
CCOS  NOP           ENTRY POINT 
      JSB .ENTR     GET ADDRESSES 
      DEF CY
* 
*********************************************************************** 
* 
*     CALL COMMON ROUTINE WITH A = ADDR(X)
* 
      LDA CX        SET A = DEF(X)
      JSB COMON 
      JMP CCOS,I    ERROR RETURN
* 
*********************************************************************** 
      SKP 
*********************************************************************** 
* 
*     CALCULATE REAL(Y) = (E(IX) + E(-IX)) * COS(RX)/2
* 
      FMP COS2
      DST CY,I      STORE REAL(Y) 
* 
*********************************************************************** 
* 
*     CALCULATE IMAG(Y) = (E(-IX) - E(IX)) * SIN(RX)/2
* 
      ISZ CY        BUMP Y ADDR TO IMAG(Y)
      ISZ CY
* 
      DLD EDIFF     E(-IX) - E(IX)
      FMP SIN2      (E(-IX) - E(IX)) * SIN(RX)/2
      DST CY,I      STORE IMAG(Y) 
* 
*********************************************************************** 
* 
*     BUMP RETURN ADDRESS AND RETURN
* 
      ISZ CCOS
      JMP CCOS,I    RETURN
* 
*********************************************************************** 
      SKP 
*********************************************************************** 
* 
*     COMPLEX SIN 
* 
*     CALLING SEQUENCE:   Y=CSIN(X) 
* 
*                         JSB CSIN
*                         DEF *+3 
*                         DEF Y 
*                         DEF X 
*                         <ERROR RETURN>
*                         <NORMAL RETURN> 
* 
*********************************************************************** 
* 
SY    BSS 1 
SX    BSS 1 
* 
CSIN  NOP           ENTRY POINT 
      JSB .ENTR     GET ADDRESSES 
      DEF SY
* 
*********************************************************************** 
* 
*     CALL COMMON ROUTINE WITH A = ADDR(X)
* 
      LDA SX
      JSB COMON 
      JMP CSIN,I    ERROR RETURN
* 
*********************************************************************** 
* 
*     CALCULATE REAL(Y) = (E(IX) + E(-IX)) * SIN(RX)/2
* 
      FMP SIN2      (E(IX) + E(-IX)) * SIN(RX)/2
      DST SY,I      STORE IN REAL(Y)
* 
*********************************************************************** 
      SKP 
*********************************************************************** 
* 
*     CALCULATE IMAG(Y) =  (E(IX) - E(-IX)) * COS(RX)/2 
* 
      ISZ SY        BUMP Y ADDR TO IMAG(Y)
      ISZ SY
* 
      DLD EDIFF     E(-IX) - E(IX)
      JSB ..FCM     E(IX) - E(-IX)
      FMP COS2      (E(IX) - E(-IX)) * COS(RX)/2
      DST SY,I      STORE IN IMAG(Y)
* 
*********************************************************************** 
* 
*     BUMP RETURN ADDRESS AND RETURN
* 
      ISZ CSIN
      JMP CSIN,I    RETURN
* 
*********************************************************************** 
      SKP 
*********************************************************************** 
* 
* 
*     COMMON ROUTINE FOR CCOS AND CSIN
* 
*     CALLING SEQUENCE:   LDA SX(CX)
*                         JSB COMON 
*                         <ERROR RETURN>
*                         <NORMAL RETURN> 
* 
* 
COMON NOP           ENTRY POINT 
      STA X         SET X = ADDR(X) 
* 
*********************************************************************** 
* 
*     COMPUTE COS2 = COS(RX)/2
* 
      DLD X,I 
      JSB COS 
      JMP COMON,I   ERROR RETURN
* 
      FDV F2.0
      DST COS2
* 
*********************************************************************** 
* 
*     COMPUTE SIN2 = SIN(RX)/2
* 
      DLD X,I 
      JSB SIN 
      JMP COMON,I   ERROR RETURN
* 
      FDV F2.0
      DST SIN2
* 
*********************************************************************** 
      SKP 
*********************************************************************** 
* 
*     COMPUTE EXPIX = EXP(IMAG(X))
* 
      ISZ X         BUMP X ADDR TO IMAG(X)
      ISZ X 
* 
      DLD X,I 
      JSB EXP 
      JMP COMON,I   ERROR RETURN
* 
      DST EXPIX 
* 
*********************************************************************** 
* 
*     CALCULATE EXPMX = EXP(-IMAG(X))= 1.0 / EXP(IMAG(X)) 
* 
      DLD F1.0
      FDV EXPIX 
      DST EXPMX 
* 
*********************************************************************** 
* 
*     COMPUTE EDIFF = E(-IMAG(X)) - E(IMAG(X))
* 
      FSB EXPIX 
      DST EDIFF 
* 
*********************************************************************** 
* 
*     RETURN WITH (A B) = E(IMAG(X) + E(-IMAG(X)) 
* 
      DLD EXPIX 
      FAD EXPMX 
* 
      ISZ COMON     SET NORMAL RETURN 
      JMP COMON,I   RETURN
* 
*********************************************************************** 
      SKP 
*********************************************************************** 
* 
X     BSS 1 
COS2  BSS 2 
SIN2  BSS 2 
EXPIX BSS 2 
EXPMX BSS 2 
EDIFF BSS 2 
F1.0  DEC 1.0 
F2.0  DEC 2.0 
* 
*********************************************************************** 
      END 
                                                                                                                                                                                                                                                            