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$
                                                                                              