FTN4,L SUBROUTINE PPGSS(IUNIT,PER,MOD,DEL,WID,RL,TE,ICHAN),09580-16307 +1926 790321 C C------------------------------------- C C HP 8160A PROGRAMMABLE PULSE GENERATOR C (PPGSS) C C RELOCRABLE 09580-16307 C SOURCE 09580-18307 C C R.UNTALAN REV. 1840 C R.UNTALAN REV. 1926 MARCH 21,1979 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 HP 8160A PROGRAMMABLE PULSE GENERATOR. C C HARDWARE REQUIRED: C ------------------ C A. HP 8160A 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 PPGSS(I,R,I,R,R,R,R,I), OV=XX, ENT=PPGSS, FIL=%PPGSS C C CONFIGURATION TABLE ENTRIES: C ---------------------------- C C C R 49,1,11 C U1 C 2 NUMBER OF CHANNELS AVAILABLE 1=CHAN A 2=CHAN A &CHAN B C 0.0 TEMPORARY STORAGE FOR CHAN A LO-LEVEL C 0.0 TEMPORARY STORAGE FOR CHAN A HI-LEVEL C 0.0 TEMPORARY STORAGE FOR CHAN B LO-LEVEL C 0.0 TEMPORARY STORAGE FOR CHAN B HI-LEVEL C 0 TEMPORARY STORAGE FOR IMPEDANCE C 0 TEMPORARY STORAGE FOR A SEP B OR A ADD B C C C C C C------------------------------------ C C PPGSS(IUNIT,PER,MODE,DEL,WID,RL,TE,ICHAN) C C WHERE: C C IUNIT = UNIT # C C PER = PERIOD C 20.0NS TO 999MS (SEE TABLE 1) C +1 = EXTERNAL POSITIVE SLOPE C -1 = EXTERNAL NEGATIVE SLOPE C C MOD = MODE OF DELAY C 0=NORMAL C 1=DOUBLE PULSE (DBL) C C C DEL = DELAY C IF MODE=0 , 0.00NS TO 999 MS C C DELAY IS PROGRAMMABLE TO 94% OF PERIOD VALUE - 30 NS. C C DELAYS LESS THAN 50 NS CAN BE PROGRAMMED WITHOUT C LIMITATION FROM THE PERIOD VALUE. C C IF MODE=1 (DOUBLE PULSE) 20 NS TO 999MS C C C WID = WIDTH C 10.0NS TO 999 MS (SEE TABLE 1) C C WIDTH IS PROGRAMMABLE TO 94% OF PERIOD VALUE - 30NS. C (0.94 PER - 8 NS FOR WID <50 NS) C C C C RL = LEADING EDGE C 6 NS TO 9.99 MS (SEE TABLE 1) C C TE = TRAILING EDGE C 6 NS TO 9.99MS (SEE TABLE 1) C C LEADING EDGE AND TRAILING EDGE ARE INDEPENDENTLY C PROGRAMMABLE WITHIN A COMMON RANGE. RANGES ARE C OVERLAPPING AS SHOWN BELOW. C C 06.0 NS - 99.9 NS ! 05.0 US - 99.9 US C 050 NS - 999 NS ! 050 US - 999 US C 0.50 US - 9.99 US ! .50 MS - 9.99 MS C C PROGRAMMABILITY WITHOUT LOSS OF AMPLITUDE C ----------------------------------------- C C LEADING EDGE: 70% WID C TRAILING EDGE: 70% * (0.94*PER - WID) C C C NOTE: SLOPE ERROR IS NORMAL WHEN PROGRAMMED VALUES ARE VERY C CLOSE TO THE LIMITS OF THE INSTRUMENT. C C C ICHAN = CHANNEL C 0 = A C 1 = B C C C TABLE 1: OUTPUT MODES & TIMING (8160 INTO 50 OHM) C------------------------------------------------------------------- C ! ! ! ! ! C OUTPUT MODE ! PER ! WID ! DEL ! LEE/TRE ! C ! ! ! ! ! C ! ! ! ! MIN ! ACCURACY ! C------------------------------------------------------------------- C ! ! ! ! ! ! C A SEP B ! 20 NS! 10 NS ! 1% +/- 1NS ! 6.0 NS ! 3% +/- 1 NS ! C 50 OHM ! ! ! ! ! ! C ! ! ! ! ! ! C A SEP B ! 25 NS ! 12.5NS!1% +/- 2.5NS ! 8.0 NS ! 3% + - 2NS ! C 1K OHM ! ! ! ! ! ! C ! ! ! ! ! ! C A ADD B ! 50 NS ! 25 NS ! 1% +/- 6 NS! 15 NS ! 3% +/- 4 NS ! C 50 OHM ! ! ! ! ! ! C ! ! ! ! ! ! C A ADD B ! 50 NS ! 25 NS ! 1% +/- 6 NS! 15 NS ! 3% +/- 4 NS ! C 1K OHM ! ! ! ! ! ! C ! ! ! ! ! ! C------------------------------------------------------------------- C C DIMENSION IERMS(5) DATA IDTN / 49 / DATA IERMS / 10,5,2HPP,2HGS,2HS / C IERMS=10 C C FIND STATION AND LU #'S C ISTN = STATION # C LU1 = HP 8160A 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 XPGSS(LU1,LUIB,IERMS,IUNIT,PER,MOD,DEL,WID,RL,TE,ICHAN) 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 XPGSS(LU1,LUIB,IERMS,IUNIT,PER,MOD,DEL,WID,RL,TE, +ICHAN),09580-16307 1926 790321 DIMENSION IERMS(5),IREG(2),ITME(4),IDLY(3) DIMENSION IOBUF(35),IPS(4),IPBUF(17),IR(2),IBUF(11) EQUIVALENCE (REG,IREG,IA),(IREG(2),IB) DATA IDLY / 2HDE,2HDB / DATA ITME /2HMS,2HUS,2HNS / C C--------------------------------------------- C C C THE PARAMETERS IN THE CALLING SEGUENCE HAVE THE FOLLOWING C MEANINGS. C C LUIB = LU # OF HPIB BUSS. C LU1 = LU # OF HP8160A 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 C C C C READ CONFIGURATION TABLE FOR 8160 C CALL TIM(49,IUNIT,1,IBUF,11,IER) IF(IER .NE. 0) RETURN C C CHECK WHICH MODE OF OUTPUT IS CURRENTLY SELECTED C (A SEP B) OR (A ADD B) C IF(IBUF(11) .EQ. 1) GOTO 555 C IF((IBUF(10)/2)*2 .NE. IBUF(10)) GOTO 444 C C SET MINIMUM LIMITS FOR A SEP B , 50 OHM C PERMN=20E-9 WIDMN=10E-9 RLMIN=6E-9 C GOTO 666 C C SET MINIMUM LIMITS FOR A SEP B ,1K OHM C 444 PERMN=25E-9 WIDMN=12.5E-9 RLMIN=8E-9 C GOTO 666 C C C SET MINIMUM LIMITS FOR A ADD B, 50 OHM OR 1K OHM C 555 PERMN=50E-9 WIDMN=25E-9 RLMIN=15E-9 C C 666 MAX=IBUF-1 C C C C C C C CHECK PARAMETERS C C INUM=29 KNUM=16 C IF (PER .GE. 0 .AND. PER .LE. PERMN) PER=PERMN IF(WID .GE. 0 .AND. WID .LE. WIDMN) WID=WIDMN IF (RL .GE. 0 .AND. RL .LE. RLMIN) RL=RLMIN IF (TE .GE. 0 .AND. TE .LE. RLMIN) TE=RLMIN C C C C C C C C IERMS=1 IF(PER .LT. 20.0E-9 .OR. PER .GT. 0.999)GOTO 77 GOTO 78 77 IF(PER .NE. 1.0 .OR. PER .NE. -1.0) GOTO 8000 C 78 IF(MOD .LT. 0 .OR. MOD .GT. 1) GOTO 8000 C IF(DEL .LT. 0.0 .OR. DEL .GT. .999) GOTO 8000 C IF(MOD .EQ.1 .AND. DEL .LT. 20E-9) GOTO 8000 C 80 IF(WID .LT. WIDMN) GOTO 8000 C IF(PER .LT. PERMN) GOTO 8000 IF(TE .LT. 5.0E-9 .OR. TE .GT. .00999) GOTO 8000 C C CHECK IF VALID CHANNEL SELECTED C IF(ICHAN .LT. 0 .OR. ICHAN .GT. MAX) GOTO 8000 C C C C C SET MAXIMUM LIMITS LEE/TRE, AND PERIOD C RLMAX=.7*WID - 1E-9 TEMAX=.7*(.94*PER-WID) PERMX=.999 C C IF(TEMAX .LT. RLMIN) TEMAX=RLMIN IF(RLMAX .LT. RLMIN) RLMAX=RLMIN C C C CHECK LEADING AND TRAILING EDGES FOR MAXIMUM LIMIT C C C C C IF(RL .GT. RLMAX) GOTO 8000 IF(TE .GT. TEMAX) GOTO 8000 IF(PER .GT. PERMX) GOTO 8000 C C C C C C CHECK IF LEADING EDGE AND TRAILING EDGE ARE C ON THE SAME RANGE. IF NOT, THEN CHECK THE LOWER IF C WITHIN THE OVERLAP. IF NOT WITHIN THE OVERLAP THEN C ERROR-1. C DO 66 I=1,2 C IF(I .EQ. 1) TNUM=RL IF(I .EQ. 2) TNUM=TE C IRNG=1 RMAX=100E-9 C 34 IF(TNUM-RMAX) 33,32 C 32 RMAX=RMAX*10.0 IRNG=IRNG+1 GOTO 34 C C 33 IR(I)=IRNG 66 CONTINUE C IF(IR .EQ. IR(2)) GOTO 87 C C C IRDIF=IABS(IR(1)-IR(2)) IF(IRDIF .GE. 2) GOTO 8000 C C IF(RL-TE) 61,87,51 C C 51 IF(IR .EQ. 6 .AND. TE .LT. 500E-6) GOTO 8000 IF(IR .EQ. 5 .AND. TE .LT. 500E-7) GOTO 8000 IF(IR .EQ. 4 .AND. TE .LT. 500E-8) GOTO 8000 IF(IR .EQ. 3 .AND. TE .LT. 500E-9) GOTO 8000 IF(IR .EQ. 2 .AND. TE .LT. 50E-9 ) GOTO 8000 GOTO 87 C C 61 IF(IR(2) .EQ. 6 .AND. RL .LT. 500E-6) GOTO 8000 IF(IR(2) .EQ. 5 .AND. RL .LT. 500E-7) GOTO 8000 IF(IR(2) .EQ. 4 .AND. RL .LT. 500E-8) GOTO 8000 IF(IR(2) .EQ. 3 .AND. RL .LT. 500E-9) GOTO 8000 IF(IR(2) .EQ. 2 .AND. RL .LT. 50E-9 ) GOTO 8000 C C C C CHECK WIDTH AND DELAY PARAMETER C C 87 WMAX=(.94*PER)-3.0E-8 C C DMAX=WMAX IF(DMAX .LE. 49E-9) DMAX=49E-9 C IF(WID .LT. 50E-9) WMAX = (.94*PER) - 8E-9 C C C C C IF(MOD .EQ. 0) GOTO 99 C C C C C SET MAXIMUM LIMIT FOR WIDTH IF DBL IS ALSO SELECTED C C 89 IF(WID .GE. 50E-9) WMAX=(.98*DEL)-30E-9 C IF(WID .LT. 50E-9) WMAX=(.98*DEL) -8E-9 C C C C C 99 IF(WID .GE. WMAX) GOTO 8000 IF(DEL .GE. DMAX) GOTO 8000 C C C SET UP OUTPUT BUFFER FOR PERIOD C IF (ABS(PER) .EQ. 1.0) GOTO 22 C CALL SCAL(PER,BNUM,INDX) C C 10 CALL F2A(BNUM,IPS) IOBUF(1)=2HPE IOBUF(2)=2HR IOBUF(3)=IPS(2) IOBUF(4)=IPS(3) IOBUF(5)=ITME(INDX) GOTO 21 C C 22 IF(PER .EQ. -1.0) IOBUF(1)=2HE2 IF(PER .EQ. 1.0) IOBUF(1)=2HE1 IOBUF(2)=2H IOBUF(3)=2H IOBUF(4)=2H IOBUF(5)=2H C C C SET OUTPUT BUFFER FOR DELAY MODE C 21 IOBUF(6)=2H IOBUF(7)=IDLY(MOD+1) IOBUF(8)=2HL IF(IBUF .GT. 1) IOBUF(8)=2HLA+ICHAN C C CLEAR STRING BUFFER C DO 100 I=1,4 100 IPS(I)=2H C C C SET OUTPUT BUFFER FOR DELAY SETTING C CALL SCAL(DEL,BNUM,INDX) 20 CALL F2A(BNUM,IPS) IOBUF(9)=IPS(2) IOBUF(10)=IPS(3) IOBUF(11)=ITME(INDX) C C CLEAR STRING BUFFER C DO 200 I=1,4 200 IPS(I)=2H C C C SET OUTPUT BUFFER FOR WIDTH C CALL SCAL(WID,BNUM,INDX) 30 CALL F2A(BNUM,IPS) IOBUF(12)=2H IOBUF(13)=2HWI IOBUF(14)=42101B+ICHAN IOBUF(15)=IPS(2) IOBUF(16)=IPS(3) IOBUF(17)=ITME(INDX) IOBUF(18)=2H C C CLEAR BUFFER STRING C DO 300 I=1,4 300 IPS(I)=2H C C C SET OUTPUT BUFFER FOR LEADING EDGE C CALL SCAL(RL,BNUM,INDX) 40 CALL F2A(BNUM,IPS) IOBUF(19)=2HLE IOBUF(20)=42501B+ICHAN IOBUF(21)=IPS(2) IOBUF(22)=IPS(3) IOBUF(23)=ITME(INDX) IOBUF(24)=2H C C CLEAR BUFFER STRING C DO 500 I=1,4 500 IPS(I)=2H C C C SET OUPUT BUFFER FOR TRAILING EDGE C CALL SCAL(TE,BNUM,INDX) 50 CALL F2A(BNUM,IPS) IOBUF(25)=2HTR IOBUF(26)=42501B+ICHAN IOBUF(27)=IPS(2) IOBUF(28)=IPS(3) IOBUF(29)=ITME(INDX) C C CLEAR STRING BUFFER C DO 600 I=1,4 600 IPS(I)=2H C C C DO NOT OUTPUT CHANNEL INDICATOR IF UNIT IS A SINGLE CHAN. C IF(IBUF .EQ. 2) GOTO 700 C IOBUF(8)=IAND(IOBUF(8),177400B) IOBUF(14)=IAND(IOBUF(14),177400B) IOBUF(20)=IAND(IOBUF(20),177400B) IOBUF(26)=IAND(IOBUF(26),177400B) C C C C C C PRESET UNIT TO MINIMUM VALUES C C 700 IPBUF(1)=IOBUF(19) IPBUF(2)=IOBUF(20) IPBUF(3)=2H5 IPBUF(4)=2HNS IPBUF(5)=IOBUF(25) IPBUF(6)=IOBUF(26) IPBUF(7)=2H5 IPBUF(8)=IPBUF(4) IPBUF(9)=IOBUF(13) IPBUF(10)=IOBUF(14) IPBUF(11)=2H10 IPBUF(12)=IPBUF(4) IPBUF(13)=2HDE IPBUF(14)=IOBUF(8) IPBUF(15)=2H00 IPBUF(16)=IPBUF(4) C C C C C C 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 C INITIALIZE UNIT FIRST C KNUM=16 122 CALL REIO(100002B,LU1,IPBUF(1),KNUM,IDUMY,0) GOTO 9000 65 CALL ABREG(IA,IB) IF(IB .LT. 0) GOTO 8500 C C C C 123 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 C CLEAR SRQ C C CALL EXEC(100003B,600B+LU1) GOTO 9000 88 CALL ABREG(IA,IB) IF(IB .LT. 0) GOTO 8500 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)=2HPP IERMS(4)=2HGS IERMS(5)=2HS RETURN END C C------------------------------------------- C C SUBROUTINE SCAL(ANUM,BNUM,INDX),09580-16307 1926 790321 C C IF(ANUM .LE. .999) BNUM=ANUM*1E3 IF(ANUM .LE. .999E-3)BNUM=ANUM*1E6 IF(ANUM .LE. .999E-6)BNUM=ANUM*1E9 C C INDX=1 IF(ANUM .LE. .999E-3) INDX=2 IF(ANUM .LE. .999E-6) INDX=3 C C RETURN END END$