FTN4,L SUBROUTINE RMSSU(IUNIT,IFUNC,IRNG,IMODE,IDEL), +09580-16294 REV.2026 800219 C C------------------------------------- C C HP 3403C TRUE RMS VOLTMETER. C C RELOCATABLE 09580-16294 C SOURCE 09580-18294 C C V.POVIO 771008 REV. A C BOB RICHARDS 800219 C C------------------------------------ C C !=================================================! C ! ! C ! (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980 ! 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 PROPRIETARY ! C ! MATERIAL OF THE HEWLETT-PACKARD COMPANY. ! C ! ! C ! THIS SOURCE DATA SHALL BE USED SOLELY IN ! C ! CONJUNCTION 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 3403C TRUE RMS VOLTMETER. C C HARDWARE REQUIRED: C ------------------ C A. HP 3403C TRUE RMS VOLTMETER C B. 11146A I/O CARD C C JUMPER POSITION: C S1 AND S2 SET TO A C C C. 28058-60001 I/O CABLE C C INPUT/OUTPUT WORD FORMAT: C ------------------------- C C BIT 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 C ------------------------------------------------- C ! ! WAIT!RL! ! ! ! !FUNC ! N! S! A! RANGE ! C ------------------------------------------------- C C WHERE: C C RL = REMOTE/LOCAL C 0 = LOCAL C 1 = REMOTE C C WAIT = WAIT C 01 = 1 MSEC DELAY BETWEEN ENCODE C AND START OF MEASUREMENT C C FUNC = FUNCTION C C 00 = AC+DC C 01 = DC ONLY C 10 = AC ONLY C C N = NORMAL/DELAYED C 0 = NORMAL C 1 = DELAYED C C S = SLOW/FAST C 0 = SLOW C 1 = FAST C C A = AUTORANGE C 0 = LOCAL C 1 = AUTORANGE C C RANGE = RANGE C C 000 = 1000V C 001 = 100V C 010 = 10V C 011 = 1V C 100 = .1V C 101 = .01V C C INPUT DATA WORD #1 C ------------------ C C BIT 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 C ------------------------------------------------- C ! RANGE !#4!BCD DIGIT 3!BCD DIGIT 2!BCD DIGIT 1! C ------------------------------------------------- C C RANGE = NUMBER OF DECIMAL PLACES FROM RIGHT ,0 TO 5 C C BITS 0 TO 12 = RETURNED BCD DATA C C ALL BITS 0 = TRUE C C INPUT DATA WORD #2 C ------------------ C C BIT 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 C ------------------------------------------------- C ! NOT USED !RC!UN!OV!PO! FUN ! C ------------------------------------------------- C C FN = FUNCTION C 11 = DC+AC C 10 = DC ONLY C 01 = AC ONLY C C PO = POLARITY C 0 = + C 1 = - C C OV = OVERRANGE C 1 = NO C 0 = YES C C UN = UNDERRANGE C 1 = NO C 0 = YES C RC = REMOTE CHECK C 0 = REMOTE C 1 = NOT IN REMOTE C C********************************************************************** C C ERROR CODES C C 0 = NO ERRORS C 1 = PARAMETER ERROR C 2 = TIMEOUT ERROR C 9 = I/O CALL REJECTED C 10 = LU NOT ASSIGNED TO STATION OR ILLEGAL LU C C********************************************************************** C C BRANCH AND MNEMONIC TABLE ENTRIES: C ---------------------------------- C C RMSSU(I,I,I,I,I), OV=XX, ENT=RMSSU, FIL=%RMSSU C RMSMU(I,RV,IV), OV=XX, ENT=RMSMU, FIL=%RMSSU C C CONFIGURATION TABLE ENTRIES: C ---------------------------- C C R 28,1,3 C U1 C 0 OUTPUT WORD C 0 FAST/SLOW C 0 NORMAL/DELAY C C OPERATING NOTES: C ---------------- C C 1. MEASUREMENT OF DC ON THE .01V RANGE. C C THE INSTRUMENT CAN NOT BE PROGRAMMED TO MEASURE C DC ON THE .01V RANGE. C C 2. CREST FACTOR LIMITATIONS. C C IF A SIGNAL HAS A HIGH CREST FACTOR THE DVM C (IN AUTO RANGE) MAY CONTINUE TO SWITCH BETWEEN C TWO RANGES. TO OVERCOME THIS PROBLEM SET THE C DVM TO A HIGHER RANGE. C C 3. INSTRUMENT SETTLING TIME. C C MODES 4 AND 5 DO NOT ALLOW THE INSTRUMENT TO C STABILIZE AFTER A STEP INPUT CHANGE BEFORE C RETURNING DATA. THE DATA RETURNED CAN THEREFORE C BE INVALID AFTER A STEP CHANGE. IT IS RECOMMENDED C THAT MODES 4 AND 5 BE USED ONLY TO MONITOR C RELATIVELY SLOW AND SMALL CHANGES OF INPUT C AMPLITUDE. C C C------------------------------------ C C RMSSU(IUNIT,IFUNC,IRNG,IMODE,IDEL) C C WHERE: C C IUNIT = UNIT # C C IFUNC = FUNCTION C C 0 = AC ONLY C 1 = DC ONLY C 2 = AC+DC C 3 = LOCAL C IRNG = RANGE C C 0 = AUTORANGE C 1 = .01V (AC ONLY) C 2 = .1V C 3 = 1V C 4 = 10V C 5 = 100V C 6 = 1000V C C IMODE = MODE C C 0 = FAST C 1 = SLOW C C IDEL = DELAY C C 0 = NORMAL C 1 = DELAYED C C------------------------------------ DIMENSION IERMS(5) DATA IDTN / 28 / DATA IERMS / 10,5,2HRM,2HSS,2HU / C IERMS=10 C C FIND STATION AND LU #'S C ISTN=ISN(DUMMY) LU1=LUDV(ISTN,IDTN,IUNIT) IF(LU1 .LE. 0)GOTO 800 C C CALL X SUB C CALL XMSSU(LU1,IERMS,IUNIT,IFUNC,IRNG,IMODE,IDEL) IF(IERMS)800,20,800 C C EXIT C 20 RETURN C C ERROR EXIT C 800 CALL ERROR(IERMS,IERMS(2)) RETURN END SUBROUTINE XMSSU(LU1,IERMS,IUNIT,IFUNC,IRNG,IMODE,IDEL), +09580-16294 REV.2026 800219 DIMENSION IERMS(5),IBUF(10),IREG(2),IOBUF(3) EQUIVALENCE (REG,IREB,IA),(IREG(2),IB) C IERMS=1 IBUF(1)=0 C C CHECK PARAMETERS C IF(IFUNC .EQ. 3)GOTO 200 IF(IFUNC .LT. 0 .OR. IFUNC .GT. 3) GOTO 1000 IF(IRNG .LT. 0 .OR. IRNG .GT. 6)GOTO 1000 IF(IMODE .LT. 0 .OR. IMODE .GT. 1)GOTO 1000 IF(IDEL .LT. 0 .OR. IDEL .GT. 1)GOTO 1000 C C SET UP OUTPUT BUFFER C IF(IRNG .EQ. 0)IBUF=10B IF(IRNG .NE. 0)IBUF=6-IRNG IF(IMODE .EQ. 1)IBUF=IBUF+20B IF(IDEL .EQ. 0)IBUF=IBUF+40B IF(IFUNC .EQ. 1)IBUF=IBUF+100B IF(IFUNC .EQ. 0)IBUF=IBUF+200B IBUF=IBUF+30000B C C SET DRIVER TIME OUT VALUE C 200 CALL EXEC(100003B,LU1+100B,1) GOTO 8090 201 CALL ABREG(IA,IB) IF(IAND(IA,377B) .NE. 0)GOTO 8020 C C OUTPUT BUFFER (BINARY XFER MODE, TIMEOUT IS LEGAL) C CALL REIO(100002B,2100B+LU1,IBUF,1,IDUMY,0) GOTO 8090 90 CALL ABREG(IA,IB) IT=IAND(IA,377B) IF((IT .EQ. 3) .OR. (IT .EQ. 0))GOTO 802 GOTO 8020 C C SET UP CONFIGURATION FILE C 802 IOBUF(1)=IBUF IOBUF(2)=IMODE IOBUF(3)=IDEL C C OUTPUT CONFIGURATION FILE C CALL TIM(28,IUNIT,2,IOBUF,3,N) IF(N .NE. 0)RETURN C C NORMAL EXIT C IERMS=0 RETURN C C ERROR EXIT C 8020 IERMS=2 GOTO 1000 8090 IERMS=9 1000 IERMS(2)=5 IERMS(3)=2HRM IERMS(4)=2HSS IERMS(5)=2HU RETURN END C C SUBROUTINE RMSMU(IUNIT,V,ISTAT),09580-16294 REV.2026 800219 C DIMENSION IERMS(5) DATA IERMS / 10,5,2HRM,2HSM,2HU / C C------------------------------------ C C RMSMU(IUNIT,V,ISTAT) C C WHERE: C C IUNIT = UNIT # C C V = VALUE RETURNED C C NOTE: FOR OVERLOAD OR INCOMPLETED MEAS- C UREMENTS THE VALUE OF V IS SET TO C 9.99999E9. C C ISTAT = RANGE STATUS C C -2 = .01V RANGE C -1 = .1V " C 0 = 1V " C 1 = 10V " C 2 = 100V " C 3 = 1000V " C 4 = OVERRANGE ON PROGRAMMED RANGE OR C EXCESSIVE INPUT ON AUTORANGE. C 5 = UNDERRANGE ON PROGRAMMED RANGE C C NOTE: THE RANGE IDENTIFICATION CODES DEFINED C ABOVE IDENTIFY THE RANGE ACTUALLY USED C TO MEASURE THE VALUE RETURNED IN V C TO CONVERT THIS CODE TO THE ACTUAL RANGE C USED,USE THE ALGORITHM: C C R(RANGE) = 10**ISTAT C C********************************************************************** C C ERRORS C C 0 = NO ERRORS C 1 = PARAMETER ERROR C 2 = TIMEOUT ERROR C 3 = I/O CARD HUNG UP C 5 = REMOTE BIT NOT SET C 9 = I/O CALL REJECTED C 10 = LU NOT ASSIGNED TO STATION OR ILLEGAL LU C C********************************************************************** C C IERMS=10 C ISTN=ISN(DUMMY) LU1=LUDV(ISTN,28,IUNIT) IF(LU1 .LE. 0)GOTO 800 C C CALL X SUB C CALL XMSMU(LU1,IERMS,IUNIT,V,ISTAT) IF(IERMS)800,20,800 C C NORMAL RETURN C 20 RETURN C C ERROR EXIT C 800 CALL ERROR(IERMS,IERMS(2)) RETURN END C C SUBROUTINE XMSMU(LU1,IERMS,IUNIT,VAL,IRS), +09580-16294 REV.2026 800219 C C DIMENSION IERMS(5),IOBUF(5),IBUF(3) C ITIME=1000 IERMS=1 VAL=9.99999E9 C C READ CONFIGURATION FILE C CALL TIM(28,IUNIT,1,IBUF,3,N) IF( N .NE. 0)RETURN IERMS=4 IF(IBUF(1) .EQ. 0)GOTO 1000 IF(IBUF(3) .EQ. 1)ITIME=2000 C C SET DRIVER TIME OUT VALUE (TIMEOUT = ITIME * 10 MILLISECONDS) C CALL EXEC(100003B,100B+LU1,ITIME) GOTO 8090 90 CALL ABREG(IA,IB) IF(IAND(IA,377B) .NE. 0)GOTO 8020 C C READ DATA (ARM DEVICE FOR INITIAL INTERRUPT, READ INTO IOBUF W/O C INTERRUPT UNTIL BUFFER IS FULL, ARM DEVICE FOR 'DONE' FLAG, CLEAR C DEVICE AND I/O CARD.) C 100 CALL REIO(100001B,2700B+LU1,IOBUF,2) GOTO 8090 101 CALL ABREG(IA,IB) IF(IAND(IA,377B) .NE. 0)GOTO 8020 IOBUF(1)=IXOR(IOBUF(1),177777B) IOBUF(2)=IXOR(IOBUF(2),37B) C C CHECK IF REMOTE BIT SET C IF(IAND(IOBUF(2),40B) .NE. 0)GOTO 8050 C C CHECK IF I/O CARD HUNG UP C IF(IOBUF(1) .EQ. IOBUF(2))GOTO 8030 C C FIND RETURNED RANGE C IRS1=IAND(IOBUF(1),60000B) IRS1=IRS1/20000B IF(IOBUF(1) .LT. 0)IRS1=IRS1+4 IRS=3-IRS1 C C CHECK IF UNDERRANGE C IF(IAND(IOBUF(2),20B) .EQ. 0)GOTO 200 ITEMP=IAND(IBUF(1),17B) IF(ITEMP .EQ. 5B .OR. ITEMP .EQ. 10B)GOTO 200 IRS=5 GOTO 2000 C C OVERRANGE ? C 200 IF(IAND(IOBUF(2),10B) .EQ. 0)GOTO 300 IRS=4 GOTO 2000 C C CONVERT RMS READING C 300 R1=IAND(IOBUF(1),17B) R2=(IAND(IOBUF(1),360B)/2**4)*10.0 R3=(IAND(IOBUF(1),7400B)/2**8)*100.0 R4=0.0 IF(IAND(IOBUF(1),10000B) .NE. 0)R4=1000.0 IRS1=IRS1*(-1) VAL=(R1+R2+R3+R4)*10.0**IRS1 IF(IAND(IOBUF(2),4B) .EQ. 0) VAL = -VAL C C RETURN C 2000 IERMS=0 RETURN C C ERROR EXIT C 1000 IERMS=1 GOTO 9000 8020 IERMS=2 GOTO 9000 8030 IERMS=3 GOTO 9000 8050 IERMS=5 GOTO 9000 8090 IERMS=9 9000 IERMS(2)=5 IERMS(3)=2HRM IERMS(4)=2HSM IERMS(5)=2HU RETURN END END$