FTN4,L
      SUBROUTINE ANASU(IU,IRG,MMDE,MOD,INT,IBI),
     +09580-16464 REV.2026 800212 
C 
C-------------------------------------
C 
C  SCHLUMBERGER 1172 FREQUENCY RESPONSE ANALYZER
C 
C  RELOCATABLE 09580-16464
C  SOURCE      09580-18464
C 
C  BOB RICHARDS  800212 
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 PROPRIETARY 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 SCHLUMBERGER 1172 FREQUENCY RESPONSE ANALYZER. 
C 
C  HARDWARE REQUIRED: 
C  ------------------ 
C    A. SCHLUMBERGER 1172 
C    B. HP59310  BUS INTERFACE KIT. 
C 
C         JUMPER POSITION:
C          SW1-1 - 1
C          SW1-2 TO SW1-8 - 0 
C          SW2-1 - 0
C          SW2-2 - 0
C          SW2-3 - 0
C          SW2-4 - 0
C          SW2-5 - 1
C          SW2-6 - REN
C          SW2-7 - ICF
C          SW2-8 - CNX
C 
C    C. HP 21XX SERIES COMPUTER 
C 
C  BRANCH AND MNEMONIC TABLE ENTRIES: 
C  ---------------------------------- 
C 
C    ANASU(I,I,I,I,I,I),  OV=XX,   ENT=ANASU,   FIL=%ANASU
C 
C  CONFIGURATION TABLE ENTRIES: 
C  ---------------------------- 
C 
C    NONE REQUIRED
C 
C 
C 
C 
C------------------------------------ 
C 
C  ANASU(IU,IRG,MMDE,MOD,INT,IBI) 
C 
C    WHERE: 
C 
C       IU   = UNIT # 
C 
C       IRG  = INPUT RANGE
C              1=AUTO 
C              2=10MV 
C              3=100MV
C              4=1V 
C              5=10V
C              6=100V 
C 
C       MMDE = INPUT MODE 
C              1=X
C              2=Y
C              3=Y/X
C 
C       MOD  = CARRIER MODE 
C              0=BOTH OFF 
C              1=MOD. OUTPUT
C              2=DEMOD OUTPUT 
C              3=BOTH ON
C 
C       INT  = INTEGRATION TIME 
C              0=MIN
C              1=X10
C              2=X100 
C              3=X1000
C 
C       IBI  = BIAS MODE
C              0=BOTH OFF 
C              1=OUTPUT ADD 
C              2=INPUT REJECT 
C              3=BOTH ON
C 
C 
C------------------------------------ 
C 
      DIMENSION IERMS(5)
      DATA IDTN / 72 /
      DATA IERMS / 10,5,2HAN,2HAS,2HU  /
C 
      IERMS=10
C 
C  FIND STATION AND LU #'S
C   ISTN = STATION #
C   LU1 = SCHLUMBERGER 1172 LU
C   LUIB = HPIB LU
C 
      ISTN=ISN(DUMMY) 
      LU1=LUDV(ISTN,IDTN,IU)
      LUIB=IBLU0(LU1) 
      IF(LU1 .LE. 0 .OR. LUIB .LE. 0)GOTO 800 
C 
C  CALL X SUB 
C 
      CALL XNASU(LU1,LUIB,IERMS,IU,IRG,MMDE,MOD,INT,IBI)
      IF(IERMS)800,20,800 
C 
C  EXIT 
C 
20    RETURN
C 
C  ERROR EXIT 
C 
800   CALL ERROR(IERMS,IERMS(2))
      RETURN
      END 
C 
C---------------------------------------------
C 
      SUBROUTINE XNASU(LU1,LUIB,IERMS,IU,IRG,MMDE,MOD,INT,IBI), 
     +09580-16464 REV.2026 800212 
C 
      DIMENSION IERMS(5),IOBUF(12)
C 
      INTEGER LST,ARNG,AMMDE,AMOD,AINT,AIBI 
C 
      DATA LST   /52062B/ 
      DATA ARNG  /34400B/ 
      DATA AMMDE /36000B/ 
      DATA AMOD  /31400B/ 
      DATA AIBI  /31000B/ 
      DATA AINT  /37400B/ 
C 
C---------------------------------------------
C 
C 
C  THE PARAMETERS IN THE CALLING SEQUENCE HAVE THE FOLLOWING
C  MEANINGS.
C 
C     LUIB = LU # OF HPIB BUS.
C     LU1  = LU # OF SCHLUMBERGER 1172
C 
C    IERMS IS A FIVE WORD ARRAY WITH IERR(1) CONTAINING 
C    THE ERROR CODE.
C 
C        0 = NO ERROR 
C        1 = PARAMETER ERROR
C 
C    ERROR MESSAGES THAT PERTAIN TO THE HPIB. 
C 
C        9 = I/O CALL REJECTED
C       10 = LUIB OR LU1 = 0
C       12 = I/O DEVICE TIME OUT
C       13 = IFC DETECTED DURING I/O REQUEST
C       14 = SRQ ABORTED
C       15 = NON-EXISTENT ALARM PROGRAM 
C       16 = ILLEGAL CONTROL REQUEST
C       17 = EQT EXTENSION AREA FULL
C 
C    IERMS(2) = ERROR MNEMONIC CHARACTER COUNT
C    IERMS(3) TO IERMS(5) = ERROR MNEMONIC
C 
C 
C---------------------------------------------
C 
C 
C 
C  CHECK PARAMETERS 
C 
      IERMS=1 
      IF(IRG.LT.1.OR.IRG.GT.6) GO TO 8000 
      IF(MMDE.LT.1.OR.MMDE.GT.3) GOTO 8000
      IF(MOD.LT.0.OR.MOD.GT.3) GOTO 8000
      IF(INT.LT.0.OR.INT.GT.3) GOTO 8000
      IF(IBI.LT.0.OR.IBI.GT.3) GOTO 8000
C 
C  SET UP INPUT-OUTPUT BUFFER FOR WRITE TO LATCH STORE CHARACTERS 
C 
      IOBUF(1) = LST
      IOBUF(3) = LST
      IOBUF(5) = LST
      IOBUF(7) = LST
      IOBUF(9) = LST
      IOBUF(11) = LST 
C 
C  MEASUREMENT MODE TO STOP 
C 
      IOBUF(2) = 35460B 
C 
C  RANGE DATA 
C 
      IF (IRG.EQ.1) GOTO 30 
      IOBUF(4) = IOR(IOR(IRG,60B),ARNG) 
      GOTO 40 
30    IOBUF(4) = IOR(ARNG,70B)
C 
C  INPUT MODE DATA
C 
40    IOBUF(6) = IOR(IOR(MMDE,60B),AMMDE) 
C 
C  CARRIER MODE DATA
C 
      IOBUF(8) = IOR(IOR(MOD,60B),AMOD) 
C 
C  INTEGRATION TIME DATA
C 
      IOBUF(10) = IOR(IOR(INT,60B),AINT)
C 
C  BIAS MODE DATA 
C 
      IOBUF(12) = IOR(IOR(INT,60B),AIBI)
C 
C  REMOTE ENABLE
C 
      CALL EXEC(100003B,1600B+LUIB) 
      GO TO 9000
90    CALL ABREG(IA,IB) 
      IF (IB .LT. 0) GO TO 8500 
C 
C  SEND OUTPUT BUFFER 
C 
      CALL EXEC (100002B,LU1,IOBUF,12,IDUMY,0)
      GO TO 9000
91    CALL ABREG(IA,IB) 
      IF (IB .LT. 0) GO TO 8500 
C 
C  RETURN 
C 
7000  IERMS = 0 
      RETURN
C 
C  ERROR EXIT 
C 
8500  IERMS=IAND(IA,377B)+11
      GOTO 8000 
9000  IERMS=9 
8000  IERMS(2)=5
      IERMS(3)=2HAN 
      IERMS(4)=2HAS 
      IERMS(5)=2HU
      RETURN
      END 
      END$
                                                                                                          