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 
                                                                                        