FTN4,L
C 
      SUBROUTINE SGNSU(IUNIT,IFUNC,IMODE,FREQ,AMP,OFSET,IOUT),
     +09580-16298 REV.2001 791023 
C 
C 
C-------------------------------------
C 
C  HP 8165A PROGRAMMABLE SIGNAL SOURCE
C      (SGNSU)
C 
C  RELOCATABLE 09580-16298
C  SOURCE     09580-18298 
C 
C  V.POVIO   780322    REV. A 
C  R.UNTALAN 790307    REV. B 
C  R.UNTALAN 790426    REV. C 
C  BOB RICHARDS 791023
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  ! CONJUNCTION WITH ELECTRONIC COMPUTER SYSTEMS    !
C  ! SUPPLIED TO THE USER BY HEWLETT-PACKARD.        !
C  !                                                 !
C  ! THIS PROPRIETARY 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 HP 8165A PROGRAMMABLE SIGNAL SOURCE. 
C 
C  HARDWARE REQUIRED: 
C  ------------------ 
C    A. HP 81665A PROGRAMMABLE SIGNAL SOURCE. 
C    B. HP59310  BUS 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    SGNSU(I,I,I,R,R,R,I),  OV=XX,   ENT=SGNSU,   FIL=%SGNSU
C 
C  CONFIGURATION TABLE ENTRIES: 
C  ---------------------------- 
C 
C    R 48,1,5 
C    U1 
C       5   STD=5,OPT 001=7 
C       0.0 TEMP STORAGE FOR FREQUENCY
C       0.0 TEMP STORAGE FOR FREQUENCY
C 
C 
C 
C------------------------------------ 
C 
C  SGNSU(IUNIT,IFUNC,IMODE,FREQ,AMP,OFSET,IOUT) 
C 
C    WHERE: 
C 
C       IUNIT = UNIT #
C 
C       IFUNC = FUNCTION
C 
C               1 = SINE WAVE 
C               2 = TRIANGLE WAVE 
C               3 = SQUARE WAVE 
C       IMODE = INPUT MODE
C 
C               1 = NORMAL
C               2 = VCO 
C               3 = TRIGGER 
C               4 = GATE
C               5 = BURST 
C 
C       FREQ  = FREQUENCY .001 HZ TO 50.0 MHZ 
C 
C       AMP   = AMPLITUDE 
C 
C               10.0 MVPP TO 10.0 VPP (50 OHMS OUTPUT IMPEDANCE)
C               2.0 VPP TO 20.0 VPP   (1K OHMS OUPUT IMPEDANCE) 
C 
C       OFSET = OFFSET
C 
C               0 +/- 10 MV TO +/- 5.0 V  (50 OHMS) 
C               0 +/- 20 MV TO +/- 10.0 V (IK OHMS) 
C 
C       IOUT  = OUTPUT MODE 
C 
C               0 = DISABLE 
C               1 = ENABLE/NORM/50 OHMS 
C               2 = ENABLE/NORM/1K OHMS 
C               3 = ENABLE/INV/50 OHMS
C               4 = ENABLE/INV/1K OHMS
C 
C------------------------------------ 
      DIMENSION IERMS(5)
      DATA IDTN / 48 /
      DATA IERMS / 10,5,2HSG,2HNS,2HU  /
C 
      IERMS=10
C 
C  FIND STATION AND LU #'S
C   ISTN = STATION #
C   LU1 = HP 8165A 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 XGNSU(LU1,LUIB,IERMS,IUNIT,IFUNC,IMODE,FREQ,AMP,OFSET,IOUT)
      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 XGNSU(LU1,LUIB,IERMS,IU,IFUN,IMDE,FREQ,AMP,OFSET,IOUT),
     +09580-16298 REV.2001 791023 
      DIMENSION IERMS(5),IBUF(5),IREG(2),IOBUF(35),AMPL(4)
      DIMENSION OFSEL(4),IFS(8),IAS(3),RBUF(4),RBUF1(4),CBUF(2) 
      EQUIVALENCE (REG,IREG,IA),(IREG(2),IB)
      EQUIVALENCE (CBUF,IBUF(2))
      DATA AMPL /.01,10.0,2.0,20.0/ 
      DATA OFSEL /.01,5.0,.02,10.0/ 
      DATA RBUF /1000.0,1.0,.001,.000001/ 
      DATA RBUF1 /.001,.1,100.0,1000.0/ 
C 
C---------------------------------------------
C 
C 
C  THE PARAMETERS IN THE CALLING SEGUENCE HAVE THE FOLLOWING
C  MEANINGS.
C 
C     LUIB = LU # OF HPIB.
C     LU1  = LU # OF HP8165A
C 
C    IERMS IS A FIVE WORD ARRAY WITH IERR(1) CONTAINING 
C      THE ERROR CODE.
C 
C        0 = NO ERROR 
C        1 = PARAMETER ERROR
C 
C    ERROR MESSAGES THAT PERTAIN TO THE HPIB. 
C 
C        9 = I/O CALL REJECTED
C       10 = LUIB OR LU1 = 0
C       12 = I/O DEVICE TIME OUT
C       13 = IFC DETECTED DURING I/O REQUEST
C       14 = SRQ ABORTED
C       15 = NON-EXISTENT ALARM PROGRAM 
C       16 = ILLEGAL CONTROL REQUEST
C       17 = EQT EXTENSION AREA FULL
C 
C    IERMS(2) = ERROR MNEMONIC CHARACTER COUNT
C    IERMS(3) TO IERMS(5) = ERROR MNEMONIC
C 
C 
C---------------------------------------------
C 
C 
C  RETRIEVE CONFIGURATION DATA
C 
      CALL TIM(48,IU,1,IBUF,5,IER)
      IF(IER .NE. 0)RETURN
C 
C  CHECK PARAMETERS 
C 
      IERMS=1 
      IF(IOUT .EQ. 0) GOTO 1000 
C 
      IF(IFUN .LT. 1 .OR. IFUN .GT. 3) GOTO 8000
C 
      IF(IMDE .LT. 1 .OR. IMDE .GT. 5) GOTO 8000
C 
      IF(FREQ .LT. .001) FREQ=.001
      IF(FREQ .GT. 50.0E+6) GOTO 8000 
C 
      IF(IOUT .LT. 0 .OR. IOUT .GT. 4) GOTO 8000
      I1=1
      IF(IOUT .EQ. 2 .OR. IOUT .EQ. 4) I1=3 
      IF(AMP .LT. AMPL(I1)) AMP=AMPL(I1)
      IF(AMP .GT. AMPL(I1+1)) GOTO 8000 
C 
      I2=1
      IF(IOUT .EQ. 2 .OR. IOUT .EQ. 4) I2=3 
      IF(ABS(OFSET) .LT. OFSEL(I2)) OFSET=0.0 
      IF(ABS(OFSET) .GT. OFSEL(I2+1))GOTO 8000
C 
      IF((AMP+OFSET) .GT. AMPL(I2+1))GOTO 8000
C 
C  CLEAR OUTPUT BUFFER
C 
      DO 170 I=1,33 
170   IOBUF(I)=2H 
C 
C 
C 
      DO 175 J=1,4
175   IFS(J)=20040B 
C 
C 
C  SET UP OUTPUT BUFFER FOR MODE & FUNCTION 
C 
      IOBUF(1)=2HF0+IFUN
      IOBUF(2)=2HI0+IMDE
C 
C  SET UP OUTPUT BUFFER FOR FREQUENCY 
C 
      IF1=4 
      IF(FREQ .LT. 1.0E+6) IF1=3
      IF(FREQ .LT. 1000.0) IF1=2
      IF(FREQ .LT. 1.0) IF1=1 
      F2=(FREQ*RBUF(IF1)) 
      CALL F2A(F2,IFS(1)) 
      IOBUF(3)=2HFR 
      IOBUF(4)=2HQ
      IOBUF(5)=IFS(2) 
      IOBUF(6)=IFS(3) 
      IOBUF(7)=IFS(4) 
      IOBUF(8)=2H 
      IF(IF1 .EQ. 3) IOBUF(8)=2H K
      IF(IF1 .EQ. 4) IOBUF(8)=2H M
      IOBUF(9)=2HHZ 
      IF(IF1 .EQ. 1) IOBUF(9)=2HMZ
C 
C  STORE FREQUENCY AND AMPLITUDE
C 
      CBUF=FREQ 
      CALL TIM(48,IU,2,IBUF,5,IER)
      IF(IER .NE. 0) RETURN 
C 
C 
C  SET UP AMPLITUDE FIRST AT 2V WITH OUTPUT DISABLE.
C  2V IS A VOLTAGE SETTING THAT IS BOTH ACCEPTABLE
C  FOR 50 OHM AND 1 KOHM. 
C 
C 
      IOBUF(11)=2HOD
      IOBUF(12)=2H
      IOBUF(13)=2HAM
      IOBUF(14)=2HP2
      IOBUF(15)=2HV 
      IOBUF(16)=2H
C 
C     SET OUTPUT BUFFER FOR IMPEDANCE 
C 
      IOBUF(17)=2HO5
      IF(IOUT .EQ. 2 .OR. IOUT .EQ. 4) IOBUF(17)=2HO1 
C 
C 
C 
C  SET OUPUT BUFFER FOR AMPLITUDE 
C 
      DO 176 J=1,3
176   IAS(J)=20040B 
      IA1=2 
      IF(AMP .LT. .999) IA1=1 
      A2=AMP
      IF(IA1 .LT. 2)A2=AMP*1000.0 
      CALL F2A(A2,IAS(1)) 
      IOBUF(19)=2HAM
      IOBUF(21)=2HP 
      IOBUF(22)=IAS(2)
      IOBUF(23)=IAS(3)
      IOBUF(24)=2HV 
      IF(IA1 .LT. 2) IOBUF(24)=2HMV 
      IOBUF(25)=2H
C 
C 
C  SET OUTPUT BUFFER FOR OFFSET 
C 
      DO 177 J=1,3
177   IAS(J)=20040B 
      IO1=2 
      IF(ABS(OFSET) .LT. 1.0) IO1=1 
      O2=OFSET
      IF(O2 .LT. 0.0) O2=-O2
      IF(IO1 .LT. 2)O2=O2*1000.0
      CALL F2A(O2,IAS(1)) 
      IOBUF(26)=2HOF
      IOBUF(27)=2HS+
      IF(OFSET .LT. 0.0) IOBUF(27)=2HS- 
      IOBUF(28)=IAS(2)
      IOBUF(29)=IAS(3)
      IOBUF(30)=2H V
      IF(IO1 .EQ. 1) IOBUF(30)=2HMV 
C 
C  SET OUTPUT BUFFER FOR OUPUT MODE 
C 
      IOBUF(32)=2HOD
      IF(IOUT .NE. 0) IOBUF(32)=2HOE
      IOBUF(33)=2HOI
      IF(IOUT .LT. 3) IOBUF(33)=2HON
      INUM=33 
C 
      GOTO 2000 
C 
C  SET UP BUFFER FOR DISABLE MODE 
C 
1000  IOBUF(1)=2HOD 
      INUM=1
C 
C  REMOTE ENABLE
C 
2000  CALL EXEC(100003B,1600B+LUIB) 
      GOTO 9000 
70    CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C  SEND OUTPUT BUFFER 
C 
      CALL REIO(100002B,LU1,IOBUF(1),INUM,IDUMY,0)
      GOTO 9000 
71    CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C 
C  RETURN 
C 
      IERMS=0 
      RETURN
C 
C  ERROR EXIT 
C 
8500  IERMS=IAND(IA,377B)+11
      GOTO 8000 
9000  IERMS=9 
8000  IERMS(2)=5
      IERMS(3)=2HSG 
      IERMS(4)=2HNS 
      IERMS(5)=2HU
      RETURN
      END 
      END$
                                                                                                                                                                                