FTN4,L
      SUBROUTINE C45SU(IUNIT,IFUNC,IRGE,IPOS,ISAM,IGATE), 
     +09580-16289 REV.2026 800130 
C ------------------------------------------------
C THIS DEVICE SUBROUTINE PROGRAMS THE HP 5345A
C ELECTRONIC COUNTER FUNCTIONS. 
C ----------------------------------------------- 
C 
C     RELOC.             09580-16289
C     SOURCE             09580-18289
C 
C     T.KONDO            7-7-77       REV. A
C     Y.MIYAKO           3-16-79      REV. B
C     Y.MIYAKO           5-15-79      REV. C
C     BOB RICHARDS       791023 
C     BOB WRAY           800130 
C 
C     TEST SYSTEM SOURCE SOFTWARE IS THE PROPRIETARY
C     MATERIAL OF THE HEWLETT-PACKARD COMPANY.
C 
C     (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. 
C     ALL RIGHTS RESERVED. NO PART OF THIS PROGRAM
C     MAY BE PHOTOCOPIED, REPRODUCED OR TRANSLATED
C     TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR 
C     WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. 
C 
C-------------------------------------------------------------------- 
C 
C     BRANCH AND MNEMONIC TABLES ENTRIES: 
C     ----------------------------------
C 
C       C45SU(I,I,I,I,I,I),        OV=XX,       ENT=C45SU,  FIL=%C45SU
C 
C     CONFIGURATION TABLE:
C     ------------------- 
C 
C       R   6,1,3 
C       U1
C           0  (TEMP STORAGE FOR HP5345A SAMPLE RATE) 
C           0  (0 FOR HP5345A OPT. 011,  1 FOR HP5345A OPT. 012)
C           0  (TEMPORARY STORAGE FOR HP5355A SAMPLE RATE)
C 
C------------------------------------------------------------------ 
      DIMENSION IERMS(5)
      DATA IERMS/10,5,2HC4,2H5S,2HU / 
      DATA IDTN/6/
      IERMS = 10
      ISTN = ISN(DUM) 
      LU1 = LUDV(ISTN,IDTN,IUNIT) 
      LU0 = IBLU0(LU1)
      IF(LU1.LE.0.OR.LU0.LE.0)GO TO 800 
10    CALL X45SU(LU0,LU1,IERMS,IUNIT,IFUNC,IRGE,IPOS,ISAM,IGATE)
      IF(IERMS)800,20,800 
20    RETURN
C 
C 
800   CALL ERROR(IERMS,IERMS(2))
      RETURN
      END 
C 
C ----------------------------------- 
C CALL MAIN BODY OF DEVICE SUBROUTINE 
C ----------------------------------- 
C 
      SUBROUTINE X45SU(LU0,LU1,IERMS,IUNIT,IFUNC,IRGE,IPOS,ISAM,IGATE), 
     +09580-16289 REV.2026 800130 
C 
C 
C 
C CALL X45SU(LU0,LU1,IERMS,IUNIT,IFUNC,IRGE,IPOS,ISAM,IGATE)
C       WHERE:
C                    LU0  = LU # FOR HP-IB INTERFACE CARD 
C                    LU1  = LU # FOR HP5345 ELECTRONIC COUNTER
C 
C                   IERMS = 5 ELEMENT ERROR ARRAY 
C                           IERMS(1) = ERROR CODE 
C                                     0= NO ERROR 
C                                     1= PARAMETER ERROR
C                                     3= OVERRANGE ERROR
C                                     4= BAD DATA FROM 5345A
C                                     6= 'HOLD' INVALID WITH
C                                        HP 5355A INSTALLED.
C                                     7= CONFIGURTION FILE DATA 
C                                        ENTRY ERROR
C     ERROR MESSAGES WHICH PERTAIN TO THE HPIB
C     9  = I/O CALL REJECTED
C     10 = LU # NOT ASSIGNED TO HPIB DEVICE OR TO STATION 
C     11 = DMA INPUT REQUEST PREMATURELY TERMINATED 
C     12 = I/O DEVICE TIME OUT
C     13 = IFC (INTERFACE CLEAR) DETECTED DURING I/O REQUEST
C     14 = SRQ SERVICE ABORTED
C     15 = NON-EXISTENT ALARM PROGRAM 
C     16 = ILLEGAL CONTROL REQUEST
C     17 = EQT EXTENSION AREA FULL, NO NEW DEVICE MAY BE ADDED ON LINE
C                    IERMS(2) = CHARACTER COUNT OF MNEMONIC NAME
C                    IERMS(3) - IERMS(5) = DEVICE SUBROUTINE NAME 
C 
C                   IUNIT = UNIT NUMBER 
C 
C                   IFUNC = COUNTER FUNCTION
C                           0 = LOCAL (N/A ON HP5345A OPT.012)
C                           1 = PLUG IN 
C                           2 = FREQ A
C                           3 = PERIOD A
C                           4 = TIME INTERVAL A TO B
C                           5 = RATIO B/A 
C                           6 = START 
C                           7 = STOP
C                           8 = ACCUM MODE (A+B)
C                           9 = ACCUM MODE (A-B)
C                          10 = CHECK 
C 
C                   IRGE = COUNTER GATE TIME
C                          0 = MIN
C                          1 = 100 NSEC 
C                          2 = 1 USEC 
C                          3 = 10 USEC
C                          4 = 100 USEC 
C                          5 = 1 MSEC 
C                          6 = 10 MSEC
C                          7 = 100 MSEC 
C                          8 = 1 SEC
C                          9 = 10 SEC 
C                         10 = 100 SEC
C                         11 = 1000 SEC 
C                         12 = 10000 SEC
C 
C                   IPOS  = DISPLAY POSITION
C                           (DIGIT POSITION DEFINED FROM RIGHT TO LEFT, 
C                            DECIMAL POINT ON RIGHT SIDE OF DIGIT)
C                           0 THRU 10 
C                           11 = AUTO POSITION
C 
C                   ISAM  = SAMPLE RATE 
C                          1 = MINIMUM
C                          2 = MAXIMUM (50 - 100 MSEC)
C                          3 = HOLD (INVALID IF HP5355A INSTALLED-
C                              REF CALL C45HF, ISARA PARAMETER.)
C 
C                   IGATE = GATE MODE 
C                          1 = INTERNAL 
C                          2 = EXTERNAL 
C 
C 
C ----------------
C PROGRAM CODE SET
C ----------------
C 
C       FUNCTION: 
C         'F2' = PLUG IN              'F0' = FREQ. A
C         'F1' = PERIOD               'F3' = TIME INTERVAL A TO B 
C         'F5' = RATIO                'F4' = START
C         'F6' = STOP 
C         'E=' = ACCOM MODE (A+B)     'E5' = ACCOM MODE (A-B) 
C         'E;' = EXT. GATE            'E3' = INT. GATE
C       GATE TIME:
C         'G4' = 10000 SEC            'G3' = 1000 SEC 
C         'G2' = 100 SEC              'G1' = 10 SEC 
C         'G0' = 1 SEC                'G?' = 100 MSEC 
C         'G>' = 10 MSEC              'G=' = 1 MSEC 
C         'G<' = 100 USEC             'G;' = 10 USEC
C         'G:' = 1 USEC               'G9' = 100 NSEC 
C         'G5' = MIN
C       INPUT AMPLIFIER:
C         'E7' = COM A OR SEPARATE    'E?' = CHECK
C       SAMPLE RATE:
C         'E1E4' = MAX                'E1E<' = MIN
C         'E9' = HOLD 
C       OUTPUT MODE:
C         'E2' = ONLY IF ADDRESSED    'E:' = WAIT UNTIL ADDRESSED 
C       DISPLAY POSITION: 
C         'D;' = 0 DIGITS             'D:' = 1 DIGIT
C         'D9' = 2 DIGITS             'D8' = 3 DIGITS 
C         'D?' = 4 DIGITS             'D>' = 5 DIGITS 
C         'D=' = 6 DIGITS             'D<' = 7 DIGITS 
C         'D3' = 8 DIGITS             'D2' = 9 DIGITS 
C         'D1' = 10 DIGITS            'D0' = AUTO POS & AUTO SUFFIX 
C        NOTE: THE AUTO POSITION ('D0') IS NORMALLY PROGRAMMED. 
C              THIS POSITIONS THE DISPLAY'S LEAST-SIGNIFICANT DIGIT 
C              IN THE RIGHT MOST COLUMN WITH THE CORRECT DISPLAY
C              MULTIPLIER AUTOMATICALLY SELECTED. PROGRAMMING THE 
C              DISPLAY MULTIPLIER IS NOT REQUIRED IN AUTO DISPLAY.
C              DISPLAY PROGRAMMING OF 0 DIGITS TO 10 DIGITS SHIFTS
C              THE DECIMAL POINT (LEFT) AND REQUIRES MULTIPLIER 
C              SUFFIX TO BE PROGRAMMED. 
C       DISPLAY MULTIPLIER SUFFIX:
C         'C7' = GHZ    NSEC     G
C         'C6' = MHZ    USEC     M
C         'C5' = KHZ    MSEC     K
C         'C4' = HZ     SEC 
C         'C3' = mHZ    KSEC
C       REMOTE PROGRAM INITIALIZE = 'I2'
C         SET THE COUNTER AS FOLLOWS: 
C            FREQ A, 1SEC GATE, AUTO DISPLAY, COM A OR SEPARATE 
C            (DEPENDING ON FRONT PANEL) LOCAL OPERATION, OUTPUT 
C            ONLY IF ADDRESSED, INTERNAL GATE, SAMPLE RATE NOT
C            HOLD, SAMPLE RATE ^ 50 MSEC, AND A-B START MODE. 
C       LOCAL - REMOTE: 
C        (THIS PARAMETER IS NOT APPLICABLE TO HP5345A OPT. 012) 
C         'E0' = LOCAL                'E8' = REMOTE 
C       RESET COMMAND  = 'I1' 
C          THE RESET COMMAND CAUSES THE CURRENT MEASUREMENT CYCLE 
C          TO BE TERMINATED AND A NEW CYCLE TO BEGIN. AFTER NEW 
C          PROGRAM CODES, THIS COMMAND IS ISSUED TO ENSURE THAT 
C          THE MEASUREMENT CYCLE IS STARTED WITH NEW PROGRAM. 
C          IF RESET COMMAND IS ISSUED TO THE COUNTER WHILE THE
C          COUNTER IS PROGRAMMED FOR WAIT UNTIL ADDRESS('E:') 
C          THE COUNTER WILL IMMEDIATELY GO TO AN OUTPUT CYCLE 
C          AND OUTPUT ALL ZEROS. ONLY WHEN THE OUTPUT IS COMPLETE 
C          AND SAMPLE TRIGGER OCCURS WILL A NEW MEASUREMENT 
C          BEGIN. 
C       SAMPLE TRIGGER COMMAND = 'J1' 
C 
C 
      DIMENSION IDATA(14),KSAMP(3),IFNC(10),IGTME(13),IERMS(5)
      DIMENSION IRATE(5),IDPOS(12),IREG(2)
      EQUIVALENCE(REG,IREG,IA),(IREG(2),IB) 
C 
C 
C ----------------
C SET PROGRAM DATA
C ----------------
C 
      DATA IFNC/2HF2,2HF0,2HF1,2HF3,2HF5,2HF4,2HF6, 
     12HE=,2HE5,2HE?/ 
C 
      DATA IGTME/2HG5,2HG9,2HG:,2HG;,2HG<,2HG=,2HG>,
     12HG?,2HG0,2HG1,2HG2,2HG3,2HG4/
C 
      DATA IDT2 / 6/
C 
      DATA IDPOS/2HD;,2HD:,2HD9,2HD8,2HD?,2HD>,2HD=,
     12HD<,2HD3,2HD2,2HD1,2HD0/ 
C 
C --------------------- 
C INITIALIZE ERROR CODE 
C --------------------- 
C 
      IERMS = 0 
C 
C --------------- 
C TEST PARAMETERS 
C --------------- 
C 
      IF(IFUNC.LT.0.OR.IFUNC.GT.10)GO TO 9100 
      IF(IRGE.LT.0.OR.IRGE.GT.12)GO TO 9100 
      IF(IPOS.LT.0.OR.IPOS.GT.11)GO TO 9100 
      IF(ISAM.LT.1.OR.ISAM.GT.3)GO TO 9100
      IF(IGATE.LT.1.OR.IGATE.GT.2)GO TO 9100
      CALL TIM(IDT2,IUNIT,1,KSAMP,3,JER)
      IF(JER.NE.0)GO TO 9100
      IF(KSAMP(2).LT.0.OR.KSAMP(2).GT.1)GO TO 9100
      IF(KSAMP(3).GT.2) GO TO 9400
      IF(KSAMP(3).EQ.0.OR.KSAMP(3).EQ.1) GO TO 20 
      IF(ISAM.EQ.3) GO TO 9300
C 
C --------------------
C SET COUNTER FUNCTION
C --------------------
C 
      IF(IFUNC.NE.0)GO TO 20
      IF(KSAMP(2).EQ.1)GO TO 9100 
      IDATA(1) = 2HE0 
      IDATA(2) = 2HI1 
      NUM = 2 
      GO TO 100 
C 
C --------------------------------- 
C INITIALIZE REMOTE PROGRAM STORAGE 
C --------------------------------- 
C     FREQ A, 1 SEC GATE, AUTO DISPLAY, COM A OR SEPEARATE, 
C     LOCAL, INT GATE, SAMPLE RATE - MAX, A - B START MODE
C 
20    IDATA(1) = 2HI2 
      NUM = 1 
C 
C ----------------------------------------------------
C SET UP DATA IN TIM FOR C45RD TO INDICATE SAMPLE RATES 
C OF HP5345A AND HP 5355A.
C ----------------------------------------------------
C 
      KSAMP(1) = 0
      KSAMP(3) = 0
      IF(ISAM.EQ.3)KSAMP(1) = 1 
      CALL TIM(IDT2,IUNIT,2,KSAMP,3,JER)
      IF(JER.NE.0)RETURN
C 
C ------------------------------
C CHECK FUNCTION FOR FREQUENCY A
C ------------------------------
C 
22    CONTINUE
      IF (IFUNC.EQ.2)GO TO 25 
C 
C ------------------------------- 
C OTHER FUNCTION THAN FREQUENCY A 
C ------------------------------- 
C 
      IDATA(2) = IFNC(IFUNC)
      NUM = 2 
25    NUM = NUM+1 
C 
C --------------------------- 
C CHECK GATE TIME = 1 SECONDS 
C --------------------------- 
C 
      IF (IRGE.EQ.8)GO TO 30
C 
C ------------------------- 
C GATE TIME IS NOT 1 SECOND 
C ------------------------- 
C 
      IDATA(NUM) = IGTME(IRGE+1)
      NUM = NUM+1 
C 
C ------------------- 
C CHECK REMOTE GATING 
C ------------------- 
C 
30    IF (IGATE.NE.1)IDATA(NUM) = 2HE;
      IF (IGATE.NE.1)NUM = NUM+1
C 
C --------------- 
C INPUT = CHECK ? 
C --------------- 
C 
      IF (IFUNC.EQ.10)IDATA(NUM) = 2HE? 
      IF (IFUNC.EQ.10)NUM = NUM+1 
C 
C ----------------- 
C CHECK SAMPLE RATE 
C ----------------- 
C 
      IF(ISAM.EQ.2)GO TO 35 
      IDATA(NUM) = 2HE9 
      NUM = NUM+1 
      IF(ISAM.EQ.3)GO TO 35 
      IDATA(NUM-1) = 2HE1 
      IDATA(NUM) = 2HE< 
      NUM = NUM+1 
C 
C ----------------
C DISPLAY POSITION
C ----------------
C 
35    CONTINUE
      IF (IPOS.EQ.11)GO TO 40 
C 
C ------------------------
C OTHER THAN AUTO-POSITION
C ------------------------
C 
      IDATA(NUM) = IDPOS(IPOS+1)
      IDATA(NUM+1) = 2HC4 
      NUM = NUM+2 
C 
C ------------------------- 
C INITIALIZE REMOTE PROGRAM 
C ------------------------- 
C 
40    IDATA(NUM) = 2HI1 
      IDATA(NUM+1) = 2HE8 
      NUM = NUM+1 
C 
100   CALL EXEC(100003B,1600B+LU0)
      GO TO 8000
660   CALL ABREG(IA,IB) 
      IF(IB.LT.0)GO TO 990
C 
C --------------------------------
C PROGRAM 5345A ELECTRONIC COUNTER
C --------------------------------
C 
      IF(KSAMP(2).EQ.1)NUM=NUM-1
99    CALL REIO(100002B,LU1,IDATA(1),NUM,IDUMY,0) 
      GO TO 8000
999   CALL ABREG(IA,IB) 
      IF (IB.LT.0)GO TO 990 
C 
C ------
C RETURN
C ------
C 
      RETURN
C 
C ------------
C ERROR RETURN
C ------------
C 
8000  IERMS = 9 
      GO TO 9900
9100  IERMS = 1 
      GO TO 9900
9300  IERMS = 6 
      GO TO 9900
9400  IERMS = 7 
      GO TO 9900
990   IERMS = IAND(IREG,377B) + 11
9900  IERMS(2) = 5
      IERMS(3) = 2HC4 
      IERMS(4) = 2H5S 
      IERMS(5) = 2HU
      RETURN
      END 
      SUBROUTINE C45SS(IUNIT,IMODE),09580-16289 REV.2026 800130 
C-----------------------------------------------------------
C 
C --------------------------------------------
C THIS DEVICE SUBROUTINE PROGRAMS THE HP 5345A
C ELECTRONIC COUNTER START & STOP FUNCTIONS.
C --------------------------------------------
C 
C     BRANCH AND MNEMONIC TABLES ENTRIES
C     ----------------------------------
C 
C     C45SS(I,I),          OV#=XX,     ENT=C45SS, FIL=%C45SU
C 
C-------------------------------------------------------------------
      DIMENSION IERMS(5)
      DATA IERMS/10,5,2HC4,2H5S,2HS / 
      IERMS = 10
      ISTN = ISN(DUM) 
      LU = LUDV(ISTN,6,IUNIT) 
      LUIB = IBLU0(LU)
      IF(LU)800,800,10
10    CALL X45SS(LUIB,LU,IERMS,IMODE) 
      IF(IERMS)800,20,800 
20    RETURN
C 
C 
800   CALL ERROR(IERMS,IERMS(2))
      RETURN
      END 
      SUBROUTINE X45SS(LUIB,LCTR,IERR,IMODE),09580-16289 REV.2026 
     +800130
C 
C 
C 
C 
C 
C --------------------------------
C CALL X45SS(LUIB,LCTR,IERR,IMODE)
C --------------------------------
C        WHERE: 
C              LUIB  = LU OF HPIB INTERFACE CARD
C              LCTR  = LU OF HP 5345A ELECTRONIC COUNTER
C 
C              IERR  = 5 ELEMENT ERROR ARRAY
C                      IERR(1) = ERROR CODE 
C 
C                        0= NO ERROR
C                        1= PARAMETER ERROR 
C     ERROR MESSAGES WHICH PERTAIN TO THE HPIB
C 
C     9 = I/O CALL REJECTED 
C     10 = LU NOT ASSIGNED TO HPIB DEVICE OR TO STATION.
C     11 - DMA INPUT REQUEST PREMATURELY TERMINATED 
C     12 - I/O DEVICE TIME OUT
C     13 - IFC (INTERFACE CLEAR) DETECTED DURING I/O REQUEST
C     14 - SRQ SERVICE ABORTED
C     15 - NON-EXISTENT ALARM PROGRAM 
C     16 - ILLEGAL CONTROL REQUEST
C     17 - EQT EXTENSION AREA FULL, NO NEW DEVICE MAY BE ADDED ON LINE
C 
C                      IERR(2) = CHARACTER COUNT OF MNEMONIC NAME 
C                      IERR(3) - IERR(5) = DEVICE SUBROUTINE NAME 
C 
C              IMODE = MODE 
C                      0    STOP
C                      1    START 
C 
C 
C 
C 
C 
C 
      DIMENSION IBUF(1),IERR(5),IREG(2) 
C 
      EQUIVALENCE(REG,IREG,IA),(IREG(2),IB) 
C 
C 
C ----------------
C SET PROGRAM DATA
C ----------------
C 
      DATA IWRT/100002B/
C 
C ----------------
C INITIALIZE ERROR
C ----------------
      IERR=0
C 
      IF(IMODE.LT.0.OR.IMODE.GT.1)GOTO 9100 
C 
C --------
C SET MODE
C --------
C 
      IF(IMODE.EQ.0)IBUF(1)=2HF6
      IF(IMODE.EQ.1)IBUF(1)=2HF4
C 
500   CALL EXEC(100003B,1600B+LUIB) 
      GO TO 9000
550   CALL ABREG(IA,IB) 
      IF(IB.LT.0)GO TO 990
C 
C --------------------------
C PROGRAM ELECTRONIC COUNTER
C --------------------------
C 
      CALL REIO(IWRT,2000B+LCTR,IBUF,1,IDUMY,0) 
      GO TO 9000
1000  CALL ABREG(IA,IB) 
      IF(IB.LT.0)GO TO 990
C 
C ------
C RETURN
C ------
C 
      RETURN
C 
C ------------
C ERROR RETURN
C ------------
C 
9000  IERR = 9
      GO TO 9900
9100  IERR = 1
      GO TO 9900
990   IERR = IAND(IREG,377B) + 11 
9900  IERR(2) = 5 
      IERR(3) = 2HC4
      IERR(4) = 2H5S
      IERR(5) = 2HS 
      RETURN
      END 
      END$
                                                                                                                                                                              