FTN4,L SUBROUTINE C45RD(IUN45,MODE,DATA1,DATA2), +09580-16290 REV.2026 800130 C ----------------------------------------------- C THIS DEVICE SUBROUTINE PROGRAMS THE MEASUREMENT C FUNCTION OF THE 5345A ELECTRONIC COUNTER. C ----------------------------------------------- C C RELOC. 09580-16290 C SOURCE 09580-18290 C C T.KONDO 7/8/77 REV. A C Y.MIYAKO 3/16/79 REV. B C BOB WRAY 800130 C C TEST SYSTEM SOURCE SOFTWARE IS THE PROPRIETRY C MATERIAL OF THE HEWLETT-PACKARD COMPANY. C C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979 C ALL RIGHT 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 TABLE ENTRIES C C C45RD(I,I,RV,RV), OV=XX, ENT=C45RD, FIL=%C45RD C C---------------------------------------------------------------- C DIMENSION IERMS(5),KSAMP(3) DATA IERMS/10,5,2HC4,2H5R,2HD / DATA IDTN/6/,IDPN/71/ IUN55 = IUN45 IERMS = 10 ISTN =ISN(DUM) LU45 = LUDV(ISTN,IDTN,IUN45) LUB1 = IBLU0(LU45) IF (LU45.LE.0.OR.LUB1.LE.0)GO TO 800 C C -------------------------------------- C GET HP 5345A SAMPLE RATE DATA FROM TIM C -------------------------------------- C CALL TIM(IDTN,IUN45,1,KSAMP,3,JER) IF(JER.NE.0)RETURN C C --------------------------------------------------- C IF HP 5355A SAMPLE RATE NOT 'HOLD', CALL X45RD, BUT C IF HP 5355A SAMPLE RATE IS 'HOLD', THEN FIND LU NUMBERS C OF HP5355A HI-IB I/O INTERFACE CARD AND OF HP 5355A THEN C PROCEED TO CALL X45RD. C --------------------------------------------------- IF(KSAMP(3).NE.2) GO TO 10 LU55 = LUDV(ISTN,IDPN,IUN55) LUB2 = IBLU0(LU55) IF(LU55.LE.0.OR.LUB2.LE.0) GO TO 800 10 CALL X45RD(LUB1,LU45,LUB2,LU55,IERMS,IUN45, +MODE,DATA1,DATA2) IF(IERMS)800,20,800 20 RETURN C C 800 CALL ERROR(IERMS,IERMS(2)) RETURN END C C SUBROUTINE X45RD(LUB1,LU45,LUB2,LU55,IERMS,IUN45, +MODE,DATA1,DATA2), +09580-16290 2013 800130 C C CALL X45RD(LUB1,LU45,LUB2,LU55,IERMS,IUN45,IUN55, C MODE,DATA1,DATA2) C WHERE: C LUB1 = LU # FOR HP 5345A HP-IB INTERFACE CARD C LUB2 = LU # FOR HP 5355A HP-IB INTERFACE CARD C LU45 = LU # OF HP 5345A ELECTRONIC COUNTER C LU55 = LU # OF HP 5355A AUTOMATIC FREQ CONVERTER 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 HP 5345A C 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 IERMS(2) = CHARACTER COUNT OF MNEMONIC NAME C IERMS(3) - IERMS(5) = DEVICE SUBROUTINE NAME C C IUN45 = UNIT NUMBER OF HP5345A C IUN55 = UNIT NUMBER OF HP5355A (SAME AS UNIT C NUMBER OF HP5345A) C C MODE = MEASUREMENT MODE C C 0 = INITIATE AND WAIT FOR COMPLETION. C THEN RETURN WITH MEASUREMENT DATA. C C C C ****NOTE**** C C WHENEVER MODE = 1 OR 2 IN THIS CALL STATEMENT, C A SECOND CALL MUST BE MADE, IN WHICH MODE = 3 IN ORDER C TO GET A READING. C C ************ C C 1 = INITIATE A MEASUREMENT AND WAIT FOR C COMPLETION SO DATA CAN BE READ WITH C MODE = 3. C 2 = INITIATE A MEASUREMENT AND RETURN C DO NOT WAIT FOR COMPLETION. DATA CAN C BE READ WITH MODE = 3. C 3 = READ DATA ONLY C C DATA1= VALUE READ IN REAL REPRESENTATION C THE MOST-SIGNIFICANT-DIGITS C C DATA2= IF DATA1 CONTAINS MORE THAN 6 DIGITS C DATA2 CONTAINS THE LEAST-SIGNIFICANT C DIGITS. C C HP 5345A OUTPUT FORMAT: C C 1 2 3 4 5 6 7 8 C MSD (DIGITS) LSD C SP/- DDDDDDDDDDD . E +/- N CR LF C (0-9) (0,3,6,9) C DIMENSION IDATA(2),IREAD(10),IRSLT(16),IDBUF(8),IERMS(5), +ISCAL(3),KSAMP(3),IREG(2) EQUIVALENCE(REG,IREG,IA),(IREG(2),IB) C DATA IDTN/6/ C IUN55 = IUN45 IERMS = 0 C C --------------- C TEST PARAMETERS C --------------- C IF (MODE.LT.0.OR.MODE.GT.3)GO TO 9100 C C ---------------------------------------- C GET DATA FROM TIM INDICATING SAMPLE RATE C ---------------------------------------- C CALL TIM(IDTN,IUN45,1,KSAMP,3,KER) IF(KER.NE.0)RETURN C C ---------------------------------------------- C IF HP5345A MEASUREMENT MODE = 'READ DATA ONLY', C GO TO 500, WHICH PROGRAMS THE HP 5345A TO READ. C ---------------------------------------------- C 50 CONTINUE IF (MODE.EQ.3)GO TO 500 C C ------------------------------------- C SET IDATA(1) TO RESET/PRESET HP 5345A C -------------------------------------- C IDATA(1) = 2HI1 C C ------------------------------------------------------------ C SET IDATA(1) TO TRIGGER HP 5345A TO TAKE A MEASUREMENT C (WHENEVER HP5355A NOT PROGRAMMED FOR 'HOLD' SAMPLE RATE, OR C WHENEVER HP5355A IS NOT INSTALLED) C ------------------------------------------------------------ C IF(KSAMP(1).NE.0)IDATA(1) = 2HJ1 C C -------------------------------------------------------------- C SET IDATA(1) TO TRIGGER HP 5355A TO TAKE A MEASUREMENT C (WHENEVER HP5355A IS PROGRAMMED FOR 'HOLD' SAMPLE RATE) C ------------------------------------------------------------- C IF(KSAMP(3).EQ.2)IDATA(1) = 2HT IF(KSAMP(3).NE.2) GO TO 75 LU0 = LUB2 LU1 = LU55 GO TO 100 75 LU0 = LUB1 LU1 = LU45 NDATA = 1 C C ----------------------------------------------- C PROGRAM HP 5345A/HP 5355A TO TAKE A MEASUREMENT C ----------------------------------------------- 100 CALL EXEC(100003B,1600B+LU0) GO TO 9300 200 CALL ABREG(IA,IB) IF (IB.LT.0)GO TO 990 CALL REIO(100002B,LU1,IDATA,NDATA,IDUMY,0) GO TO 9300 400 CALL ABREG(IA,IB) IF(IB.LT.0)GO TO 990 C C ------------------------------------ C IF MODE = 1 OR 2, DON'T TAKE READING C ------------------------------------ C IF(MODE.NE.0)RETURN C C ------------------------ C SET COUNTER TO TALK MODE C ------------------------ C 500 CALL REIO(100001B,LU45,IREAD(2),8,IDUMY,0) GO TO 9300 600 CALL ABREG(IA,IB) IF (IB.LT.0)GO TO 990 C ---------------------------------------- C B REG CONTAINS NOS. OF WORDS TRANSMITTED C----------------------------------------- C CALL REIO(100001B,LU45,IREAD(2),8,IDUMY,0) GO TO 9300 620 CALL ABREG(IA,IB) IF (IB.LT.0)GO TO 990 C 630 LCHAR = IB DATA1 = 0.0 DATA2 = 0.0 READ2 = 0.0 DO 650 I=1, 16 650 IRSLT(I) = 0 C DO 655 I=1, 8 655 IDBUF(I) = 0 C NDPNT = 0 C DO 660 I=1, LCHAR INDEX = 2*I-1 LBYTE = IAND(IREAD(I+1),377B) IF (LBYTE.EQ.56B)NDPNT = INDEX+1 IBYTE =IAND(IREAD(I+1),177400B)/(2**8) IF (IBYTE.EQ.56B)NDPNT = INDEX C IRSLT(INDEX) = IBYTE 660 IRSLT(INDEX+1) = LBYTE C LCHAR = INDEX+1 IF (IRSLT(LCHAR).LT.60B)LCHAR = LCHAR-1 C ISCAL(1) = IRSLT(LCHAR-1) ISCAL(2) =IRSLT(LCHAR)-60B IF (IRSLT(1).EQ.40B)IRSLT(1)=53B IEX = LCHAR-2 C C -------------- C PROCESS DIGITS C -------------- C IREAD = LCHAR IF (LCHAR.LE.11)GO TO 800 IF (NDPNT.GT.9)GO TO 690 NEXP = (IEX-NDPNT)-1 IF (IRSLT(LCHAR-1).EQ.53B)LEXP = ISCAL(2)-NEXP IF (IRSLT(LCHAR-1).EQ.55B)LEXP = ISCAL(2)+NEXP C IREAD(6) = IOR(IRSLT(IEX)*400B,IRSLT(IEX+1)) IREAD(7) = IOR(IRSLT(IEX+2)*400B,40B) IREAD = 11 C IF (LEXP.LT.0)IRSLT(LCHAR-1) = 55B IF (LEXP.LT.0)LEXP = IABS(LEXP) IRSLT(LCHAR) = 60B IF (LEXP.GT.9)IRSLT(LCHAR) = 61B IRSLT(LCHAR+1) = LEXP+60B IF (LEXP.GT.9)IRSLT(LCHAR+1) = (LEXP-10)+60B LCHAR = LCHAR+1 GO TO 700 C 690 CONTINUE NEXP = NDPNT-9 IF (IRSLT(IEX+1).EQ.53B)NEXP = ISCAL(2)+NEXP IF (IRSLT(IEX+1).EQ.55B)NEXP = ISCAL(2)-NEXP ISCAL(1) = 53B IF (NEXP.LT.0)ISCAL(1) = 55B ISCAL(2) = 60B IF (NEXP.LT.0)NEXP = IABS(NEXP) IF(NEXP.GT.9)ISCAL(2) = 61B ISCAL(3) = NEXP IF(NEXP.GT.9)ISCAL(3)=NEXP-10 ISCAL(3) = ISCAL(3)+60B IREAD(6) = IOR(42400B,ISCAL(1)) IREAD(7) = IOR(ISCAL(2)*400B,ISCAL(3)) IREAD = 12 C C --------------------------- C DO LEAST SIGNIFICANT DIGITS C --------------------------- C 700 INX = 1 JNX = 9 710 INX =INX + 1 IF (JNX.GT.LCHAR)GO TO 750 LSDIG = IOR(IRSLT(JNX)*400B,IRSLT(JNX+1)) IDBUF(INX) = LSDIG JNX = JNX+2 GO TO 710 C 750 IDBUF = LCHAR-8 IREG=A2F(IDBUF,1,IDBUF,DATA2) IF(IREG)9200,800 C C -------------------------- C DO MOST SIGNIFICANT DIGITS C -------------------------- C 800 IREAD(2) = IOR(IRSLT(1)*400B,IRSLT(2)) IREG=A2F(IREAD,1,IREAD,DATA1) IF(IREG)9200,900 C 900 CONTINUE RETURN C C C ------------- C ERROR RETURNS C ------------- C 990 IERMS = IAND(IREG,377B) + 11 GO TO 9900 9300 IERMS = 9 GO TO 9900 9100 IERMS = 1 GO TO 9900 9200 IERMS = 4 9900 IERMS(2) = 5 IERMS(3) = 2HC4 IERMS(4) = 2H5R IERMS(5) = 2HD RETURN C END END$