FTN4,L
      SUBROUTINE ACP(IUNIT,IMODE,FREQ,AMP,PHAZ),
     +09580-16011 REV.2001 791023 
C 
C***************************************
C 
C  RELOCATABLE 09580-16011
C  SOURCE      09580-18011
C 
C  C.NELSON   10-11-76
C  BOB RICHARDS 791023
C 
C 
C------------------------------------ 
C 
C  !=================================================!
C  !                                                 !
C  ! (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979      !
C  !                ALL RIGHTS RESERVED              !
C  !                                                 !
C  ! NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,     !
C  ! REPRODUCED OR TRANSLATED INTO ANOTHER PROGRAM   !
C  ! LANGUAGE WITHOUT THE PRIOR WRITTEN CONSENT OF   !
C  ! THE HEWLETT-PACKARD COMPANY.                    !
C  !                                                 !
C  !-------------------------------------------------!
C***************************************
C  ELGAR DDP-3-AF2-242
C --------------------
C 
C GENERAL:
C --------
C 
C  HARDWARE CONFIGURATION 
C ----------------------- 
C   HP 21MX COMPUTER
C 
C   ELGAR DDP-3-AF2-242 DECODER PROGRAMMER
C 
C   HP 09580-60016 I/O CABLE ASSY.
C 
C   HP 11629 I/O CARD 
C 
C 
C  DATA WORD FORMAT 
C  ---------------- 
C 
C 
C   OUTPUT WORD #1  ADDRESS STROBES 
C   --------------
C 
C     !15 14 13 12!11 10  9  8! 7  6  5  4! 3  2  1  0! 
C     ------------------------------------------------- 
C     !------------N/C-------------! A0 B0 FR C0 B0 A0! 
C     !-----------------------------------------------! 
C 
C          BITS 0 THRU 2 ARE AMPLITUDE ADDRESS STROBES
C          BIT 3 IS THE FREQUENCY STROBE
C          BITS 4 AND 5 ARE PHASE ADDRESS STROBES 
C 
C   OUTPUT WORD II  BCD DATA FREQ,AMP. & PHASE
C 
C     !15 14 13 12!11 10  9  8! 7  6  5  4! 3  2  1  0! 
C     --------------------------------------------------
C     ! 10^2      !  10^1     !   10^0    !   10^-1   ! 
C     ------------------------------------------------- 
C 
C  CALL STATEMENT SUMMARY 
C  ---------------------- 
C 
C      ACP(U,M,F,A,P) 
C 
C         U=UNIT #  1 THRU 3
C 
C         M=MODE (0 OR 1) 
C            0=INDIVIDUAL UNIT CONTROL
C            1=ALL UNITS PROGRAMMED TO SAME VALUES
C 
C         F=FREQUENCY IN HERTZ (45 TO 9990) 
C 
C         A=AMPLITUDE IN VRMS (0 TO 260)
C 
C         P=PHASE ANGLE IN DEGREES (0 TO 360) 
C 
C 
C BRANCH AND MNEMONIC TABLE ENTRIES 
C --------------------------------- 
C 
C  ACP(I,I,R,R,R), OV=X, ENT=ACP, FIL=%ACP
C 
C**************************************** 
C 
C CONFIGURATION TABLE ENTRY EXAMPLE (ALLFL) 
C ----------------------------------------- 
C 
C R 42,1,1               *TYPE 42,1 ENTRY/UNIT, 1 UNIT
C U1                     *UNIT 1
C  1                     *NUMBER OF UNITS IN STATION
C 
C********************************************************** 
      DIMENSION IERMS(5)
      DATA IERMS/10,5,2HAC,2HP ,2H  / 
      DATA IDTN/42/ 
C 
C  FIND STATION # AND LU #
C 
      IERR=10 
      ISTN=ISN(DUMMY) 
      ILU1=LUDV(ISTN,IDTN)
      IF(ILU1 .EQ. 0)GOTO 800 
C 
C  JUMP TO DEVICE SUBROUTINE
C 
      CALL XCP(ILU1,IERMS,IUNIT,IMODE,FREQ,AMP,PHAZ)
      IF(IERMS)800,20,800 
20    RETURN
C 
C  ERROR EXIT 
C 
800   CALL ERROR(IERMS,IERMS(2))
      RETURN
      END 
C 
C*****************************************
C 
      SUBROUTINE XCP(ILU1,IERMS,IUNIT,IMODE,FREQ,AMP,PHAZ), 
     +09580-16011 REV.2001 791023 
      DIMENSION IBUF(3),IDATA(12),IREG(2),IBUFR(1),IERMS(5) 
      EQUIVALENCE (REG,IREG,IA),(IREG(2),IB)
C 
C********************************************** 
C 
C     INITIALIZE
C 
      IU=1
      IDTN=42 
      IERMS=1 
      DO 45 I1=1,12 
45    IDATA(I1)=0 
C 
C     READ DATA FROM CONFIGURATION TABLE
C 
110   CALL TIM(IDTN,IU,1,IBUFR,1,N) 
      IF(N.NE.0)RETURN
C 
C     CHECK PARAMETERS
C 
      IF((IUNIT.LT.0) .OR. (IUNIT.GT.IBUFR(1)))GO TO 8001 
      IF((IMODE.LT.0) .OR. (IMODE.GT.1))GO TO 8001
      IF((FREQ.LT.45) .OR. (FREQ.GT.9990))GO TO 8001
      IF((AMP.LT.0) .OR. (AMP.GT.260))GO TO 8001
      IF((PHAZ.LT.0) .OR. (PHAZ.GT.360))GO TO 8001
      IERMS=2 
C 
C  SET DO LOOP ACCORDING TO MODE PARAMETER PROGRAMMED 
C 
      IF(IMODE.EQ.1)IX=3
      IF(IMODE.EQ.0)IX=1
C 
      DO 1000 I=1,IX
C 
C  AMPLITUDE ADDRESS STROBE (IDATA(3))
C 
      IDATA(2)=IUNIT
      IF (IX.EQ.3)IDATA(2)=I
      IF(IUNIT.EQ.3)IDATA(2)=4B 
      IF(I.EQ.3)IDATA(2)=4B 
      IDATA(2)=IXOR(IDATA(2),177777B) 
      IF((IMODE .EQ. 1) .AND. (I .GT. 1))GOTO 500 
C 
C  MAKE AMPLITUDE A BCD NUMBER
C 
      IA1=(AMP/100.0) 
      IAX1=IA1*2**12
C 
      IA2=(AMP-(IA1*100))/10.0
      IAX2=IA2*2**8 
C 
      IA3=AMP-((IA1*100)+(IA2*10))
      IAX3=IA3*2**4 
C 
      IA4=(AMP*10.0)-((IA1*1000)+(IA2*100)+(IA3*10))
C 
      IDATA(3)=IAX1+IAX2+IAX3+IA4 
C 
C  MAKE PHAZ A BCD NUMBER 
C 
      IP1=(PHAZ/100.0)
      IPX1=IP1*2**8 
      IP2=(PHAZ-(IP1*100))/10.0 
      IPX2=IP2*2**4 
      IP3=PHAZ-((IP1*100)+(IP2*10)) 
      IDATA(11)=IPX1+IPX2+IP3 
C 
C  PHASE ADDRESS STROBE (IDATA(9))
C 
500   IDATA(10)=20B 
      IF(IUNIT .EQ. 3)IDATA(10)=40B 
      IF(I.EQ.3)IDATA(10)=40B 
      IDATA(10)=IXOR(IDATA(10),177777B) 
      IF((IMODE .EQ. 1) .AND. (I .GT. 1))GOTO 501 
C 
C 
C 
C  MAKE FREQUENCY A BCD NUMBER
C 
      FREQR=FREQ
      IF(FREQ .LT. 999.5)IDATA(7)=20000B
      IF(FREQ .LT. 99.9)IDATA(7)=10000B 
      IF(FREQ .GT. 999.0)FREQR=FREQ/10.0
      IF(FREQ .LT. 99.9)FREQR=FREQ*10.0 
      IF1=(FREQR/100.0) 
      IFX1=IF1*2**8 
      IF2=(FREQR-(IF1*100))/10.0
      IFX2=IF2*2**4 
      IF3=FREQR-((IF1*100)+(IF2*10))
      IDATA(7)=IDATA(7)+IFX1+IFX2+IF3 
C 
C  SET FREQ STROBE
C 
501   IDATA(6)=177767B
C 
C 
C    OUTPUT AMPLITUDE PROGRAM WORD & AMP. ADDRESS STROBE
C 
      IDATA(1)=15 
      ICNWD=1300B+ILU1
      CALL EXEC(100002B,ICNWD,IDATA(1),4,IDUMY,0) 
      GOTO 8002 
8900  CALL WAIT(ILU1,3) 
      IDATA(2)=177777B
      CALL EXEC(100002B,ICNWD,IDATA(1),4,IDUMY,0) 
      GOTO 8002 
8901  CALL WAIT(ILU1,3) 
C 
C  OUTPUT FREQUENCY TO ELGAR & FREQ STROBE
C 
      ICNWD=1300B+ILU1
      IDATA(5)=15 
      CALL EXEC(100002B,ICNWD,IDATA(5),4,IDUMY,0) 
      GOTO 8002 
8902  CALL WAIT(ILU1,3) 
      IDATA(6)=177777B
      CALL EXEC(100002B,ICNWD,IDATA(5),4,IDUMY,0) 
      GOTO 8002 
8903  CALL WAIT(ILU1,3) 
C 
C  OUTPUT PHAZ TO ELGAR UNIT & PHASE STROBE 
C 
      IF((IMODE.EQ.1).AND.(I.EQ.1)) GO TO 1000
      IF((IUNIT.EQ.1).AND.(IMODE.EQ.0))GO TO 1000 
      ICNWD=1300B+ILU1
      IDATA(9)=15 
      CALL EXEC(100002B,ICNWD,IDATA(9),4,IDUMY,0) 
      GOTO 8002 
8904  CALL WAIT(ILU1,3) 
      IDATA(10)=177777B 
      CALL EXEC(100002B,ICNWD,IDATA(9),4,IDUMY,0) 
      GOTO 8002 
C 
C 
1000  CONTINUE
C     CLEAR STROBES AND SET DATA BITS HI
C 
      IDATA(3)=0
      CALL EXEC(100002B,ICNWD,IDATA(1),4,IDUMY,0) 
      GOTO 8002 
8906  IERMS=0 
      RETURN
C 
C  ERROR EXIT ROUTINE 
C 
8002  IERMS=9 
8001  IERMS(2)=5
      IERMS(3)=2HAC 
      IERMS(4)=2HP
      IERMS(5)=2H 
      RETURN
      END 
      END$
                                                                                                                                                                                                                            