FTN4,L SUBROUTINE SFFUN(IUNIT,IFUNC,FAZE,IZERO), +09580-16314 1926 790502 C C------------------------------------- C C HP 3325A SYNTHESIZER*FUNCTION GENERATOR C (SFFUN) C C RELOCATABLE 09580-16314 C SOURCE 09580-18314 C C R.UNTALAN 780917 C R.UNTALAN 790321 C BOB RICHARDS 790502 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 ! TEST SYSTEM SOURCE SOFTWARE IS THE PROPRIETY ! C ! MATERIAL OF THE HEWLETT-PACKARD COMPANY. ! C ! ! C ! THIS SOURCE DATA SHALL BE USED SOLELY IN ! C ! CONJUCTION WITH ELECTRONIC COMPUTER SYSTEMS ! C ! SUPPLIED TO THE USER BY HEWLETT-PACKARD. ! C ! ! C ! THIS PROPRIETY DATA SHALL NOT BE COPIED OR ! C ! OTHERWISE REPRODUCED WITHOUT THE PRIOR WRITTEN ! C ! CONSENT OF HEWLETT-PACKARD, EXCEPT THAT ONE ! C ! COPY MAY BE MADE AND RETAINED BY THE USER FOR ! C ! ARCHIVE PURPOSES. ! C ! ! C ! THE USER SHALL NOT DISCLOSE THIS DATA TO ANY ! C ! THIRD PARTIES WITHOUT THE PRIOR WRITTEN CONSENT ! C ! OF HEWLETT-PACKARD. IN ADDITION, THE USER SHALL ! C ! USE AT LEAST THE SAME CARE AND SAFEGUARDS TO ! C ! PROTECT THIS DATA FROM UNAUTHORIZED USE OR ! C ! DISCLOSURE AS THE USER USES TO PROTECT ITS OWN ! C ! PROPRIETARY DATA. ! C ! ! C !=================================================! C C GENERAL: C -------- C C THE FOLLOWING DEVICE SUBROUTINES ARE USED C TO PROGRAM THE HP3325A SYNTHESIZER*FUNCTION GENERATOR. C C HARDWARE REQUIRED: C ------------------ C A. HP3325A PROGRAMMABLE PULSE GENERATOR. C B. HP59310 BUSS INTERFACE KIT. C C JUMPER POSITION: C SW1-1 - 1 C SW1-2 TO SW1-8 - 0 C SW2-1 - 0 C SW2-2 - 0 C SW2-3 - 0 C SW2-4 - 0 C SW2-5 - 1 C SW2-6 - REN C SW2-7 - ICF C SW2-8 - CNX C C C. HP 21XX SERIES COMPUTER C C BRANCH AND MNEMONIC TABLE ENTRIES: C ---------------------------------- C C SFFUN(I,I,R,I), OV=XX, ENT=SFFUN, FIL=%SFFUN C C CONFIGURATION TABLE ENTRIES: C ---------------------------- C C C R 29,1,4 C U1 C 0 ENTER 0 FOR STANDARD UNIT OR 1 FOR OPT.002 C 0 FUNCTI0N WAVEFORM TEMPORARY STORAGE C 0.0 TEMPORARY STORAGE FOR DC-OFFSET C C C C C C C------------------------------------ C C SFFUN(IUNIT,IFUNC,FAZE,IZERO) C C WHERE: C C IUNIT = UNIT # C C IFUNC= FUNCTION WAVEFORM C 0= SINE WAVE C 1= SQUARE WAVE C 2= TRIANGLE WAVE C 3= POSTIVE RAMP C 4= NEGATIVE RAMP C 5= DC ONLY C 6= PERFORM AMPLITUDE CALIBRATION C 7= PERFORM SELF TEST C C C FAZE= PHASE OFFSET C C 0.0 DEG. TO 719.9 DEG. C C C IZERO= ASSIGN ZERO PHASE POSITION TO CURRENT PHASE OFFSET C 0= NO C 1= YES C C C NOTE:WHEN IFUNC=5 OR 6 , THE FAZE AND IZERO PARAMETER ARE IGNORED. C C C------------------------------------ DIMENSION IERMS(5) DATA IDTN / 29 / DATA IERMS / 10,5,2HSF,2HFU,2HN / C IERMS=10 C C FIND STATION AND LU #'S C ISTN = STATION # C LU1 = HP 3325A LU C LUIB = 59310 LU C ISTN=ISN(DUMMY) LU1=LUDV(ISTN,IDTN,IUNIT) LUIB=IBLU0(LU1) IF(LU1 .LE. 0 .OR. LUIB .LE. 0)GOTO 800 C C CALL X SUB C CALL XFFUN(LU1,LUIB,IERMS,IUNIT,IFUNC,FAZE,IZERO) IF(IERMS)800,20,800 C C EXIT C 20 RETURN C C ERROR EXIT C 800 CALL ERROR(IERMS,IERMS(2)) RETURN END C C--------------------------------------------- C SUBROUTINE XFFUN(LU1,LUIB,IERR,IU,IFUNC,FAZE,IZERO), +09580-16314 1926 790502 C--------------------------------------------- C C DIMENSION IFBUF(10),IERR(5),IREG(2),IALRM(5) DIMENSION IBUF(4),ISTR(5) EQUIVALENCE (REG,IREG,IA),(IREG(2),IB) DATA IALRM/5,2HDV,2HIN,2HT / C C IERR=0 C C CHECK PARAMETERS C IF(IFUNC .LT. 0 .OR. IFUNC .GT. 7) GOTO 8000 C IF(FAZE .LT. 0 .OR. FAZE .GT. 719.9) GOTO 8000 C IF(IZERO .LT. 0 .OR. IZERO .GT. 1) GOTO 8000 C C C CLEAR OUTPUT BUFFER C DO 500 I=1,10 500 IFBUF(I)=2H C DO 501 I=1,5 501 ISTR(I)=2H C C C IF(IFUNC .GT. 5) GOTO 600 C C C READ CONFIGURATION TABLE C CALL TIM(29,IU,1,IBUF,4,IER) IF(IER .NE. 0) RETURN C C IBUF(2)=IFUNC C C STORE CURRENT WAVEFORM IN CONFIGURATION TABLE C CALL TIM(29,IU,2,IBUF,4,IER) IF(IER .NE. 0) RETURN C C C C PROCESS FUNCTION PARAMETER C IFUNC=(IFUNC+61B)*2**8 IF(IFUNC .EQ. 33000B) IFUNC=30000B IFBUF(1)=2HFU IFBUF(2)=IFUNC C C C PROCESS PHASE PARAMETER C IFAZE=INT(FAZE*10.0) FAZE=FLOAT(IFAZE)/10.0 CALL F2A(FAZE,ISTR) C C IFBUF(3)=2HPH IFBUF(4)=ISTR(2) IFBUF(5)=ISTR(3) IFBUF(6)=ISTR(4) IFBUF(7)=2HDE C IF(IZERO .EQ. 1) IFBUF(8)=2HAP C ICNT=8 GOTO 2000 C C 600 IFBUF(1)=2HAC IF(IFUNC .EQ. 7) IFBUF(1)=2HTE ICNT=1 C C C ARM SERVICE REQUEST C CALL SRQ(LU1,16,IALRM) C C C C C C C C REMOTE ENABLE C 2000 CALL EXEC(100003B,1600B+LUIB) GOTO 9000 2010 CALL ABREG(IA,IB) IF(IB .LT. 0) GOTO 8500 C C C 2020 CALL REIO(100002B,LU1,IFBUF(1),ICNT,IDUMY,0) GOTO 9000 2030 CALL ABREG(IA,IB) IF(IB .LT. 0) GOTO 8500 C C C C RETURN C C C CLEAR SRQ C C CALL EXEC(100003B,600B+LU1) GOTO 9000 2100 CALL ABREG(IA,IB) IF(IB .LT. 0) GOTO 8500 IERMS=0 RETURN C C C C----------------------------- C C ERROR EXIT C 8000 IERR=1 GOTO 8800 C C 9000 IERR=9 GOTO 8800 8500 IERR=IAND(IREG,377B)+11 8800 IERR(2)=5 IERR(3)=2HSF IERR(4)=2HFU IERR(5)=2HN RETURN END