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$