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$