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$