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