FTN4,L
      SUBROUTINE CTRIM(IUNIT,MODA,MODB,TRIGA,TRIGB,ICOM,INZ),09580-16129
     + REV.2013 800131  
C 
C 
C  THIS DEVICE SUBROUTINE IS USED TO SET UP THE HP-5328A UNIVERSAL
C  COUNTER. 
C 
C-------------------------------------------------------------------
C 
C      RELOC.       09580-16129 
C      SOURCE       09580-18129 
C      REV. B        770315 
C      REV. C        770901 
C      REV. D        791105 
C      REV. E        791126 REY UNTALAN 
C                    800128 BOB RICHARDS
C                    800131 BOB RICHARDS
C 
C 
C      HP 92425B TEST SYSTEM SOFTWARE IS THE PROPRIETARY
C      MATERIAL OF THE HEWLETT-PACKARD COMPANY.  USE AND
C      DISCLOSURE THEREOF ARE RESTRICTED BY WRITTEN AGREEMENT.
C 
C      (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.
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-------------------------------------------------------------------
      DIMENSION IERMS(5)
      DATA IERMS/10,5,2HCT,2HRI,2HM / 
      DATA IDTN/5/
      IERMS = 10
      ISTN = ISN(DUM) 
      LU = LUDV(ISTN,5,IUNIT) 
      IF(LU)800,800,10
C 
C 
C   CHECK IF COUNTER HAS BEEN PREVIOUSLY CALLED BY CTRST
C   IF NOT THEN MAKE A CALL TO CTRST TO INITIALIZE COUNTER
C 
10    CALL TIM(IDTN,IUNIT,1,IQ,1,IERFG) 
      IF(IERFG .NE. 0) RETURN 
C 
      IF(IQ .EQ. 1) GOTO 15 
C 
C 
      CALL CTRST(IUNIT,15,0,0)
C 
C 
15    CALL XTRIM(LU,IERMS,MODA,MODB,TRIGA,TRIGB,ICOM,INZ) 
      IF(IERMS)800,20,800 
20    RETURN
C 
C 
800   CALL ERROR(IERMS,IERMS(2))
      RETURN
      END 
      SUBROUTINE XTRIM(LCTR,IERR,MODA,MODB,TRIGA,TRIGB,ICOM,INZ),09580-1
     +6129 REV.2013 800131  
C 
C 
C 
C 
C 
C       THIS DEVICE SUBROUTINE SETS UP THE 5328A
C     UNIVERSAL COUNTER COUNTER FUNCTIONS.
C 
C     CALL XTRIM(LCTR,IERR,MODA,MODB,TRIGA,TRIGB,ICOM,INZ)
C        WHERE: 
C              LCTR  = LU OF HP 5328A UNIVERSAL COUNTER 
C 
C              IERR  = 5 ELEMENT ERROR ARRAY
C                      IERR(1) = ERROR CODE 
C 
C                        0= NO ERROR
C                        1= PARAMETER ERROR 
C                        3= OVERRANGE ERROR 
C                        4= BAD DATA FROM 5328A 
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) - IERR(4) = DEVICE SUBROUTINE NAME 
C              MODA  = A CHANNEL INPUT MODE 
C              MODB  = B CHANNEL INPUT MODE 
C                      MODE  ATTEN  COUPL  SLOPE
C                       0     X1     DC      +
C                       1     X1     DC      -
C                       2     X1     AC      +
C                       3     X1     AC      -
C                       4    X10     DC      +
C                       5    X10     DC      -
C                       6    X10     AC      +
C                       7    X10     AC      -
C              TRIGA = A CHANNEL TRIGGER LEVEL
C              TRIGB = B CHANNEL TRIGGER LEVEL
C                      -2.50<= TRIG <= 2.50 
C              ICOM  = SEP/COM/INVERT 
C                      0 = SEP
C                      1 = COM
C                      2 = INVERT A&B CHANNELS
C              INZ   = INPUT IMPEDANCE
C                      0 = A&B BOTH 1M OHM
C                      1 = A&B BOTH 50 OHM
C                      2 = A 50 OHM, B 1M OHM 
C                      3 = A 1M OHM, B 50 OHM 
C 
C 
C    CONFIGURATION TABLE ENTRIES
C-------------------------------------- 
C R 5,N,1            WHERE N= NUMBER OF UNITS 
C U1
C      0             TEMP. STORAGE FOR INITILIZE FLAG 
C . 
C . 
C---------------------------------------- 
C 
C 
C 
C 
C 
      DIMENSION IDATA(17),MODES(2,8),IERR(5),ISHFT(3) 
      DIMENSION IREG(2) 
     1,ISCI(3),IZ1(4),IZ2(4),ID(3)
C 
      EQUIVALENCE(REG,IREG,IA),(IREG(2),IB) 
C 
C 
C  SET PROGRAM DATA 
C 
      DATA MODES/2H73,2H4 ,2H73,2H5 ,2H72,2H4 ,2H72,2H5 , 
     12H63,2H4 ,2H63,2H5 ,2H62,2H4 ,2H62,2H5 /, 
     1ISHFT/1,256,256/, 
     1ISCI/2HA8,2HA9,2HB9/, 
     1IZ1/2HA0,2HA1,2HA1,2HA0/,IZ2/2HB0,2HB1,2HB0,2HB1/ 
C 
      DATA IWRT/100002B/
C 
      IERR = 0
C 
C   TEST PARAMETERS 
C 
      IF((MODA.LT.0).OR.(MODA.GT.7))GOTO 9100 
      IF((MODB.LT.0).OR.(MODB.GT.7))GOTO 9100 
      IF((TRIGA.LT.-2.50).OR.(TRIGA.GT.2.50))GOTO 9100
      IF((TRIGB.LT.-2.50).OR.(TRIGB.GT.2.50))GOTO 9100
      IF((ICOM.LT.0).OR.(ICOM.GT.2))GOTO 9100 
      IF((INZ.LT.0).OR.(INZ.GT.3))GOTO 9100 
C 
C 
C   CHECK IF COUNTER HAS BEEN INITILIZE 
C 
C  SET A CHANNEL MODE 
C 
      MOD = MODA+1
      IDATA(1) = 2H A 
      IDATA(2) = MODES(1,MOD) 
      IDATA(3) = MODES(2,MOD) 
C 
C  COMPUTE A CHANNEL TRIGGER LEVELS 
C 
C 
C  CONVERT TRIGA TO +/- X.XX FORMAT IN IDATA(4) - IDATA(6)
C 
      CALL TWO(TRIGA,IDATA(4))
C 
C  SET B CHANNEL MODE 
C 
      MOD = MODB + 1
      IDATA(7) = 2H*B 
      IDATA(8) = MODES(1,MOD) 
      IDATA(9) = MODES(2,MOD) 
C 
C  COMPUTE B CHANNEL TRIGGER LEVEL
C 
C 
C  CONVERT TRIGB TO +/- X.XX FORMAT IN IDATA(10) - IDATA(12)
C 
      CALL TWO(TRIGB,IDATA(10)) 
      IDATA(13) = 2H* 
C 
C  COMPUTE SEP/COM/INVERT 
C 
      IDATA(14) = 2HB8
      IDATA(15) = ISCI(ICOM+1)
C 
C  SET INPUT IMPEDANCE
C 
      IDATA(16) = IZ1(INZ+1)
      IDATA(17) = IZ2(INZ+1)
C 
C 
C 
C   PROGRAM UNIVERSAL COUNTER 
C 
      CALL REIO(IWRT,2000B+LCTR,IDATA,17,IDUMY,0) 
      GO TO 9000
1000  CALL ABREG(IA,IB) 
      IF(IB     .LT.0)GO TO 990 
C 
C   RETURN
C 
      RETURN
C 
C   ERROR RETURN
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) = 2HCT
      IERR(4) = 2HRI
      IERR(5) = 2HM 
      RETURN
      END 
C 
      SUBROUTINE TWO(TRIG,IDAT),09580-16129 REV.2013 800131 
C 
C     THIS SUBROUTINE CONVERTS THE TRIGGER LEVEL DATA INTO
C  THE PROPER +/-X.XX FORMAT FOR PROGRAMMING TRIGGER LEVEL
C  AND PUTS THE ASCII DATA INTO IDAT(1) THROUGH IDAT(3) AS
C   +,X. AND XX RESPECTIVELY. 
C 
C 
C 
      DIMENSION IDAT(3) 
      IDAT(1) = 2H +
      IF(TRIG.LT.0)IDAT(1) = 2H - 
      ITRIG = IFIX(100.0*(ABS(TRIG)+.001))
      IHDS = ITRIG/100
      JHDS = IHDS*100 
      ITENS = (ITRIG-JHDS)/10 
      IONES = ITRIG-JHDS-ITENS*10 
      ITENS = ITENS*256 
      IHDS = IHDS*256 
      IDAT(3) = IOR(IOR(IONES,ITENS),2H00)
      IDAT(2) = IOR(2H0.,IHDS)
      RETURN
      END 
      END$
      IF(IB.LT.0)GOTO 9100
C 
      IF(IFUNC.EQ.4)GOTO 300
      IF(IFUNC.GT.1)GOTO 100
      LENTH = 32
      IF(IBUFR(2).GT.0)LENTH = 36 
C 
C    OUTPUT FIELD CODES 
C 
      CALL REIO(100002B,LU1,IBUFR(4),LENTH,IDUMY,0) 
      GO TO 9000
70    CALL ABREG(IA,IB) 
      IF(IB.LT.0)GOTO 9100
C 
C     OUTPUT 'GO' 
C 
100   CONTINUE
      CALL REIO(100002B,LU1,MTRGO,1,IDUMY,0)
      GO TO 9000
110   CALL ABREG(IA,IB) 
      IF(IB.LT.0)GOTO 9100
      IF(IFUNC.EQ.3)RETURN
C 
C   WAIT FOR STATUS 
C 
160   IOFST = -20 
      CALL EXEC(12,0,1,0,IOFST) 
170   CONTINUE
      CALL EXEC(100003B,600B+LU1) 
      GO TO 9000
180   CALL ABREG(IA,IB) 
      ISTAT = IAND(IA,377B) 
      IF(ISTAT.GE.100B)GOTO 210 
      ITIME = ITIME + 1 
      IF(ITIME.LE.110)GOTO 160
C$
C$ ALL LINES COMMENTED OUT WITH 'C$' ARE PRE REV 2013 
C$    IF(ITIME.LE.55)GOTO 160 
C$
      GO TO 220 
C 
C     CHECK STATUS: 
C     MEASUREMENT-IN-PROCESS  OVER RANGE   SEARCH FAIL
C 
210   CONTINUE
      IF(ISTAT.EQ.100B)GOTO 300 
      IF(ISTAT.EQ.101B)GOTO 230 
215   LSTAT = 5 
      IF(ISTAT.EQ.102B)LSTAT = 1
      IF(ISTAT.EQ.103B)LSTAT = 4
      IF(ISTAT.EQ.104B)LSTAT = 3
      IF(ISTAT.EQ.105B)LSTAT = 6
      IF(ISTAT.EQ.106B)LSTAT = 8
      RETURN
C 
220   LSTAT = 2 
      RETURN
C 
230   MIPTR = MIPTR + 1 
      IF (MIPTR.GT.40)GOTO 220
C$
C$    IF (MIPTR.GT.20)GOTO 220
C$
      IOFST = -50 
      CALL EXEC(12,0,1,0,IOFST) 
C 
C   READ DATA FROM BUS
C 
300   CONTINUE
C 
C  ALL LINES COMMENTED OUT WITH 'C$' ARE PRE REV 2013 
C 
C$    CALL REIO(100001B,100B+LU1,IOBUF(2),4,IDUMY,0)
      CALL REIO(100001B,100B+LU1,IOBUF(2),5,IDUMY,0)
      GO TO 9000
310   CALL ABREG(IA,IB) 
      IF(IB.LT.0)GOTO 9100
      ISTAT = IAND(IOBUF(2),177400B)/256
      IF(ISTAT.EQ.101B)GOTO 230 
      IF(ISTAT.GT.101B)GOTO 215 
      IOBUF(1) = 10 
C  THE FOLLOWING 2 LINES ARE REV 2013 
      IF (IOBUF(2) .EQ. 40053B) IOBUF(2) = 2H+0 
      IF (IOBUF(2) .EQ. 40055B) IOBUF(2) = 2H-0 
C 
C$    ICHAR = IAND(IOBUF(5),177400B)
      ICHAR = IAND(IOBUF(5),377B) 
C$    NCHAR = IAND(IOBUF(5),377B) 
      NCHAR = IAND(IOBUF(6),177400B)/256
      IOBUF(5) = IAND(IOBUF(5),177400B) 
      IOBUF(5) = IOBUF(5) + 105B
C$    IF(ICHAR.EQ.20000B)IOBUF(5)=42453B
      IF(ICHAR.EQ.40B)IOBUF(6)=2H+0 
C$    IF(ICHAR.EQ.47000B)IOBUF(6)=34440B
      IF(ICHAR.EQ.116B)IOBUF(6)=2H-9
C$    IF(ICHAR.EQ.46400B)IOBUF(6)=31440B
      IF(ICHAR.EQ.115B)IOBUF(6)=2H-3
C$    IF(ICHAR.EQ.52400B)IOBUF(6)=33040B
      IF(ICHAR.EQ.125B)IOBUF(6)=2H-6
C$    IF(ICHAR.EQ.20000B.AND.NCHAR.EQ.126B)IOBUF(6)=30060B
      IF(ICHAR.EQ.40B.AND.NCHAR.EQ.126B)IOBUF(6)=30060B 
      IERR = A2F(IOBUF,1,IOBUF,VAL) 
      IF(IERR.NE.0)GOTO 9300
400   CONTINUE
      RETURN
C 
C     ERROR EXIT
C 
9000  IERR = 9
      GO TO 9910
9100  IERR = IAND(IREG,377B) + 11 
      GO TO 9910
9200  IERR = 4
      GO TO 9910
9300  IERR = 3
      GO TO 9910
9900  IERR = 1
9910  IERR(2) = 5 
      IERR(3) = 2HWF
      IERR(4) = 2HAM
      IERR(5) = 2HU 
      RETURN
      END 
      END$
                                                                                    