FTN4,L
      SUBROUTINE ANAME(IU,IDISP,IDELY,NOMES),09580-16467 REV.2026 800211
C 
C-------------------------------------
C 
C  SCHLUMBERGER 1172 FREQUENCY RESPONSE ANALYZER
C 
C  RELOCATABLE 09580-16467
C  SOURCE      09580-18467
C 
C  BOB RICHARDS  800211 
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 TO PROGRAM THE MEASUR-
C   MENT MODES OF 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    ANAME(I,I,I,IV),      OV=XX,   ENT=ANASU,   FIL=%ANASU 
C 
C  CONFIGURATION TABLE ENTRIES: 
C  ---------------------------- 
C 
C    NO ENTRIES NECESSARY 
C 
C 
C 
C 
C 
C------------------------------------ 
C 
C  ANAME(IU,IDISP,IDELY,NOMES)
C 
C    WHERE: 
C 
C       IU    = UNIT #
C 
C       IDISP = DISPLAY FORMAT
C              0=R, THETA 
C              1=A, B 
C              2=LOG R, THETA 
C 
C       IDELY = MEASUREMENT DELAY 
C              0=0.1 SECONDS
C              1=1 SECOND 
C              2=10 SECONDS 
C              3=100 SECONDS
C 
C       NOMES = RETURNED VALUE - NUMBER OF MEASUREMENTS TAKEN 
C 
C 
C  THIS DEVICE SUBROUTINE INITIALIZES THE MEASUREMENT PROCESS OF THE
C  1172.
C 
C  PRIOR TO USING THIS DEVICE SUBROUTINE A TYPE 1 FILE NAMED 'D1172'
C  MUST BE CREATED ON LU 3.  THE BELOW EXAMPLE DESCRIBES THE FMGR 
C  CALL TO CREATE A DATA FILE CAPABLE OF HOLDING THE MEASUREMENT
C  DATA OF UP TO 200 FREQUENCY MEASUREMENT POINTS.  DO NOT USE A
C  SECURITY CODE WHEN CREATING THE FILE.
C 
C        :CR,D1172::-3:1:200
C 
C*********************************************************************
C 
C                   ***** WARNING ***** 
C 
C   DO NOT TOUCH THE FRONT PANEL CONTROLS AT ANY TIME WHILE THE 1172
C   IS BEING PROGRAMMED IN THE REMOTE MODE.  TOUCHING THE FRONT PANEL 
C   CONTROLS WHILE IN THIS MODE MAY RESULT IN SPURIOUS DATA RETURNING 
C   FROM THE 1172.
C 
C*********************************************************************
C 
C 
C 
C------------------------------------ 
C 
      DIMENSION IERMS(5)
      DATA IDTN / 72 /
      DATA IERMS / 10,5,2HAN,2HAM,2HE  /
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 XNAME(LU1,LUIB,IERMS,IU,IDISP,IDELY,NOMES) 
      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 XNAME(LU1,LUIB,IERMS,IU,IDISP,IDELY,NOMES),
     +09580-16467 REV.2026 800211 
C 
      DIMENSION IERMS(5),IOBUF(6),INAME(3),IDCB(144),IFNSH(2),ISTRT(4)
      DIMENSION IRBUF(5),IMODE(1),STBUF(64),ISTBF(128),RDATA(2) 
C 
      EQUIVALENCE (STBUF(1),ISTBF(1)) 
C 
      DATA INAME /2HD1,2H17,2H2 / 
      DATA IDTN /72/
      DATA ISTRT /2HS1,2H11,31073B,2H2 /
      DATA IFNSH /2HT2,35460B/
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        2 = SRQ TIMEOUT
C        3 = ILLEGAL RETURN STATUS FROM 1172
C        4 = DATA FILE 'OPEN' ERROR 
C        5 = DATA FILE FULL 
C        6 = DATA FILE WRITE 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(IDISP.LT.0.OR.IDISP.GT.2) GOTO 8000
      IF(IDELY.LT.0.OR.IDELY.GT.3) GOTO 8000
      IERMS = 0 
C 
C  PRESET NUMBER OF MEASUREMENTS COUNTER
C 
      NOMES = 0 
C 
C  LOCK SUBROUTINE INTO MEMORY WHILE RUNNING
C 
      CALL EXEC(100000B+22,1) 
      GOTO 9000 
30    CALL ABREG(IA,IB) 
      IF (IB .LT. 0) GOTO 8500
C 
C  OPEN DATA BUFFER 
C 
      CALL OPEN(IDCB,IERR,INAME,3,0,-3) 
      IF (IERR .NE. 1) GOTO 8600
C 
C  OUTPUT DISPLAY AND DELAY, MEASURE MODE TO 'STOP'.
C 
      IOBUF(1) = 2HT2 
      IOBUF(2) = 2H=0 + IDISP 
      IOBUF(3) = 2HT2 
      IOBUF(4) = 2H>0 + IDELY 
      IOBUF(5) = 2HT2 
      IOBUF(6) = 35460B 
C 
C  PRESET BUFFER
C 
      DO 90 JCNT = 1,64 
      STBUF(JCNT) = -1.0E37 
90    CONTINUE
C 
C  REMOTE ENABLE
C 
40    CALL EXEC(100003B,1600B + LUIB) 
      GOTO 9000 
100   CALL ABREG(IA,IB) 
      IF (IB .LT. 0) GOTO 8000
C 
C  SEND OUTPUT BUFFER 
C 
      CALL EXEC(100002B,LU1,IOBUF,6,IDUMY,0)
      GOTO 9000 
110   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C  SETUP INTERRUPT
C 
      CALL EXEC(100002B,LU1,ISTRT,-7,IDUMY,0) 
      GOTO 9000 
120   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C  TIMEOUT + RESCHEDULE PROGRAM 
C  WAIT FOR INTERRUPT 
C 
150   ITIME = 0 
      IWAIT = 2*(10**(1+IDELY)) 
200   IOFST = -20 
      CALL EXEC(12,0,1,0,IOFST) 
210   CONTINUE
C 
C  GET STATUS - LOOK FOR '100B' 
C 
      CALL EXEC(100003B,600B + LU1) 
      GOTO 9000 
220   CALL ABREG(IA,IB) 
      ISTAT = IAND(IA,377B) 
      IF(ISTAT .GE. 100B) GOTO 230
      ITIME = ITIME + 1 
      IF (ITIME .LT. IWAIT) GOTO 200
      IERR = 2
      GOTO 8000 
230   IF (ISTAT .EQ. 100B) GOTO 245 
      IERR = 3
      GOTO 8000 
C 
C  READ DATA FROM 1172 MOS STORAGE BUFERS 
C 
245   IOBUF(1) = 2HT3 
      IOBUF(2) = 2HI
      CALL EXEC(100002B,LU1,IOBUF,-3,IDUMY,0) 
      GOTO 9000 
250   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
      CALL EXEC(100001B,LU1,IRBUF,5,IDUMY,0)
      GOTO 9000 
260   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C  GO CONVERT DATA TO FLOATING POINT
C 
      CALL BCONV(IOBUF(2),IRBUF,RDATA)
      STBUF(01) = RDATA 
C 
      IOBUF(2) = 2H1
      CALL EXEC(100002B,LU1,IOBUF,-3,IDUMY,0) 
      GOTO 9000 
270   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
      CALL EXEC(100001B,LU1,IRBUF,5,IDUMY,0)
      GOTO 9000 
275   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C  GO CONVERT DATA TO FLOATING POINT
C 
      CALL BCONV(IOBUF(2),IRBUF,RDATA)
      STBUF(02) = RDATA 
C 
      IOBUF(2) = 2H9
      CALL EXEC(100002B,LU1,IOBUF,-3,IDUMY,0) 
      GOTO 9000 
280   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
      CALL EXEC(100001B,LU1,IRBUF,5,IDUMY,0)
      GOTO 9000 
285   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C  GO CONVERT DATA TO FLOATING POINT
C 
      CALL BCONV(IOBUF(2),IRBUF,RDATA)
      STBUF(03) = RDATA 
C 
      IOBUF(2) = 2HM
      CALL EXEC(100002B,LU1,IOBUF,-3,IDUMY,0) 
      GOTO 9000 
290   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
      CALL EXEC(100001B,LU1,IRBUF,5,IDUMY,0)
      GOTO 9000 
295   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C  GO CONVERT DATA TO FLOATING POINT
C 
      CALL BCONV(IOBUF(2),IRBUF,RDATA)
      STBUF(04) = RDATA 
C 
      IOBUF(2) = 2H5
      CALL EXEC(100002B,LU1,IOBUF,-3,IDUMY,0) 
      GOTO 9000 
300   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
      CALL EXEC(100001B,LU1,IRBUF,5,IDUMY,0)
      GOTO 9000 
305   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C  GO CONVERT DATA TO FLOATING POINT
C 
      CALL BCONV(IOBUF(2),IRBUF,RDATA)
      STBUF(05) = RDATA 
C 
      IOBUF(2) = 2H=
      CALL EXEC(100002B,LU1,IOBUF,-3,IDUMY,0) 
      GOTO 9000 
310   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
      CALL EXEC(100001B,LU1,IRBUF,5,IDUMY,0)
      GOTO 9000 
315   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C  GO CONVERT DATA TO FLOATING POINT
C 
      CALL BCONV(IOBUF(2),IRBUF,RDATA)
      STBUF(06) = RDATA 
C 
      IOBUF(2) = 2HH
      CALL EXEC(100002B,LU1,IOBUF,-3,IDUMY,0) 
      GOTO 9000 
320   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
      CALL EXEC(100001B,LU1,IRBUF,5,IDUMY,0)
      GOTO 9000 
325   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C  GO CONVERT DATA TO FLOATING POINT
C 
      CALL BCONV(IOBUF(2),IRBUF,RDATA)
      STBUF(07) = RDATA 
C 
      IOBUF(2) = 2H0
      CALL EXEC(100002B,LU1,IOBUF,-3,IDUMY,0) 
      GOTO 9000 
330   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
      CALL EXEC(100001B,LU1,IRBUF,5,IDUMY,0)
      GOTO 9000 
335   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C  GO CONVERT DATA TO FLOATING POINT
C 
      CALL BCONV(IOBUF(2),IRBUF,RDATA)
      STBUF(08) = RDATA 
C 
      IOBUF(2) = 2H8
      CALL EXEC(100002B,LU1,IOBUF,-3,IDUMY,0) 
      GOTO 9000 
340   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
      CALL EXEC(100001B,LU1,IRBUF,5,IDUMY,0)
      GOTO 9000 
345   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C  GO CONVERT DATA TO FLOATING POINT
C 
      CALL BCONV(IOBUF(2),IRBUF,RDATA)
      STBUF(09) = RDATA 
C 
      IOBUF(2) = 2HL
      CALL EXEC(100002B,LU1,IOBUF,-3,IDUMY,0) 
      GOTO 9000 
350   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
      CALL EXEC(100001B,LU1,IRBUF,5,IDUMY,0)
      GOTO 9000 
355   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C  GO CONVERT DATA TO FLOATING POINT
C 
      CALL BCONV(IOBUF(2),IRBUF,RDATA)
      STBUF(10) = RDATA 
      STBUF(11) = RDATA(2)
C 
      IOBUF(2) = 2H4
      CALL EXEC(100002B,LU1,IOBUF,-3,IDUMY,0) 
      GOTO 9000 
360   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
      CALL EXEC(100001B,LU1,IRBUF,5,IDUMY,0)
      GOTO 9000 
365   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C  GO CONVERT DATA TO FLOATING POINT
C 
      CALL BCONV(IOBUF(2),IRBUF,RDATA)
      STBUF(12) = RDATA 
      STBUF(13) = RDATA(2)
C 
      IOBUF(2) = 2H<
      CALL EXEC(100002B,LU1,IOBUF,-3,IDUMY,0) 
      GOTO 9000 
370   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
      CALL EXEC(100001B,LU1,IRBUF,5,IDUMY,0)
      GOTO 9000 
375   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C  GO CONVERT DATA TO FLOATING POINT
C 
      CALL BCONV(IOBUF(2),IRBUF,RDATA)
      STBUF(14) = RDATA 
      STBUF(15) = RDATA(2)
C 
      IOBUF(2) = 2HJ
      CALL EXEC(100002B,LU1,IOBUF,-3,IDUMY,0) 
      GOTO 9000 
380   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
      CALL EXEC(100001B,LU1,IRBUF,5,IDUMY,0)
      GOTO 9000 
385   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C  GO CONVERT DATA TO FLOATING POINT
C 
      CALL BCONV(IOBUF(2),IRBUF,RDATA)
      STBUF(16) = RDATA 
C 
      IOBUF(2) = 2H2
      CALL EXEC(100002B,LU1,IOBUF,-3,IDUMY,0) 
      GOTO 9000 
390   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
      CALL EXEC(100001B,LU1,IRBUF,5,IDUMY,0)
      GOTO 9000 
395   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C  GO CONVERT DATA TO FLOATING POINT
C 
      CALL BCONV(IOBUF(2),IRBUF,RDATA)
      STBUF(17) = RDATA 
C 
      IOBUF(2) = 2H:
      CALL EXEC(100002B,LU1,IOBUF,-3,IDUMY,0) 
      GOTO 9000 
400   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
      CALL EXEC(100001B,LU1,IRBUF,5,IDUMY,0)
      GOTO 9000 
405   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C  GO CONVERT DATA TO FLOATING POINT
C 
      CALL BCONV(IOBUF(2),IRBUF,RDATA)
      STBUF(18) = RDATA 
C 
      IOBUF(2) = 35440B 
      CALL EXEC(100002B,LU1,IOBUF,-3,IDUMY,0) 
      GOTO 9000 
410   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
      CALL EXEC(100001B,LU1,IRBUF,5,IDUMY,0)
      GOTO 9000 
412   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C  GO CONVERT DATA TO FLOATING POINT
C 
      CALL BCONV(IOBUF(2),IRBUF,RDATA)
      STBUF(19) = RDATA 
C 
      IOBUF(2) = 2H6
      CALL EXEC(100002B,LU1,IOBUF,-3,IDUMY,0) 
      GOTO 9000 
415   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
      CALL EXEC(100001B,LU1,IRBUF,5,IDUMY,0)
      GOTO 9000 
420   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C  GO CONVERT DATA TO FLOATING POINT
C 
      CALL BCONV(IOBUF(2),IRBUF,RDATA)
      STBUF(20) = RDATA 
C 
      IOBUF(2) = 2HK
      CALL EXEC(100002B,LU1,IOBUF,-3,IDUMY,0) 
      GOTO 9000 
425   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
      CALL EXEC(100001B,LU1,IRBUF,5,IDUMY,0)
      GOTO 9000 
430   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C  GO CONVERT DATA TO FLOATING POINT
C 
      CALL BCONV(IOBUF(2),IRBUF,RDATA)
      STBUF(21) = RDATA 
C 
      CALL EXEC(100002B,LU1,ISTRT,-7,IDUMY,0) 
      GOTO 9000 
485   CALL ABREG(IA,IB) 
      IF (IB .LT. 0) GOTO 8500
C 
C  WRITE TO BUFFER
C 
      CALL WRITF(IDCB,IERR,ISTBF) 
      IF (IERR .EQ. -12) GOTO 8700  
      IF (IERR .LT. 0) GOTO 8800
      DO 487 JCNT = 1,64
      STBUF(JCNT) = -1.0E37 
487   CONTINUE
C 
C  INCREMENT NUMBER OF MEASUREMENTS COUNTER 
C 
      NOMES = NOMES + 1 
C 
C  CHECK TO SEE IF DONE 
C 
      IOBUF(1) = 2HT4 
      IOBUF(2) = 2H8
C 
      CALL EXEC(100002B,LU1,IOBUF,-3,IDUMY,0) 
      GOTO 9000 
490   CALL ABREG (IA,IB)
      IF (IB .LT. 0) GOTO 8500
C 
C  READ MEASUREMENT MODE
C 
      CALL EXEC(100001B,LU1,IMODE,1,IDUMY,0)
      GOTO 9000 
495   CALL ABREG(IA,IB) 
      IF (IB .LT. 0) GOTO 8500
C 
C  IF MEASUREMENT MODE IS 'OFF' OR 'HOLD' STOP MEASUREMENT
C 
      JSTAT = IAND(IMODE,177400B) 
      IF (JSTAT.EQ.30000B.OR.JSTAT.EQ.30400B) GOTO 500
      GOTO 150
C 
C  TURN OFF MEASUREMENT COMMAND 
C 
500   CALL EXEC(100002B,LU1,IFNSH,2,IDUMY,0)
      GOTO 9000 
510   CALL ABREG(IA,IB) 
      IF(IB.LT.0) GOTO 8500 
C 
C  GOOD RETURN
C 
7000  IERMS = 0 
C 
C  CLOSE DATA BUFFER
C 
7100  CALL CLOSE(IDCB)
C 
C  REENABLE SWAPPING
C 
      CALL EXEC(22,0) 
C 
C 
      RETURN
C 
C  ERROR EXIT 
C 
8500  IERMS=IAND(IA,377B)+11
      GOTO 8000 
8600  IERMS = 4 
      GOTO 8000 
8700  IERMS = 5 
      GOTO 8000 
8800  IERMS = 6 
      GOTO 8000 
9000  IERMS=9 
8000  IERMS(2)=5
      IERMS(3)=2HAN 
      IERMS(4)=2HAM 
      IERMS(5)=2HE
      GOTO 7100 
      END 
      SUBROUTINE BCONV(ICHAR,IRBUF,RDATA),09580-16467 REV.2026 800211 
C 
C  THIS SUBROUTINE CONVERTS THE VARIOUS DATA FORMATS AS RECEIVED FROM 
C  THE 1172 TO FLOATING POINT.
C 
C  CALL BCONV(ICHAR,IRBUF,RDATA)
C 
C       WHERE:
C 
C              ICHAR = INPUT CHARACTER IN UPPER 8 BITS, SPACE IN
C                      LOWER 8 BITS.
C 
C              IRBUF = FIVE WORD INPUT ASCII DATA BUFFER
C                      BUFFER FORMAT - "AAAA,AAAA"
C 
C              RDATA = TWO WORD ARRAY CONTAINING THE RETURNED 
C                      FLOATING POINT VALUE(S).  THETA REQUIRES 
C                      TWO CONVERSIONS PER ENTRY. 
C 
C***********************************************************************
C 
      DIMENSION IRBUF(5),RDATA(2),MRBUF(5)
      EQUIVALENCE (MRBUF(1),IVALU),(MRBUF(3),JVALU) 
C 
C  MOVE INPUT BUFFER
C 
      MRBUF(1) = IRBUF(1) 
      MRBUF(2) = IRBUF(2) 
      MRBUF(3) = IRBUF(3) 
      MRBUF(4) = IRBUF(4) 
      MRBUF(5) = IRBUF(5) 
C 
C 
C  GET RID OF IMBEDDED COMMA IN ASCII STRING
C 
      MRBUF(3) = MRBUF(3) * 400B
      MRBUF(3) = MRBUF(3) + (IRBUF(4)/400B) 
      MRBUF(4) = MRBUF(4) * 400B
      MRBUF(4) = MRBUF(4) + (MRBUF(5)/400B) 
      IS = (MRBUF(4)/400B) - 60B
      IE = (IAND(MRBUF(4),377B)) - 60B
C 
C  POINT TO REFORMAT TYPE 
C 
      IF (ICHAR .EQ. 2HI ) GOTO 100 
      IF (ICHAR .EQ. 2H1 ) GOTO 100 
      IF (ICHAR .EQ. 2HM ) GOTO 100 
      IF (ICHAR .EQ. 2H5 ) GOTO 100 
      IF (ICHAR .EQ. 35440B) GOTO 100 
      IF (ICHAR .EQ. 2HH ) GOTO 100 
      IF (ICHAR .EQ. 2H0 ) GOTO 100 
      IF (ICHAR .EQ. 2H8 ) GOTO 100 
      IF (ICHAR .EQ. 2H9 ) GOTO 100 
      IF (ICHAR .EQ. 2H= ) GOTO 100 
      IF (ICHAR .EQ. 2HL ) GOTO 500 
      IF (ICHAR .EQ. 2H4 ) GOTO 500 
      IF (ICHAR .EQ. 2H< ) GOTO 500 
      IF (ICHAR .EQ. 2HJ ) GOTO 600 
      IF (ICHAR .EQ. 2H2 ) GOTO 600 
      IF (ICHAR .EQ. 2H: ) GOTO 600 
      IF (ICHAR .EQ. 2H6 ) GOTO 800 
      IF (ICHAR .EQ. 2HK ) GOTO 1100
      GOTO 9000 
C 
100   CALL CODE 
      READ (IVALU,110) RDATA
110   FORMAT (E6.0) 
      IF (IS .EQ. 1 .OR. IS .EQ. 5) RDATA = -RDATA
      RDATA = RDATA/100000.0
      RDATA = RDATA * (10.0**(IE-4))
      RETURN
C 
500   CALL CODE 
      READ(IVALU,510) RDATA(1)
510   FORMAT (E4.0) 
      RDATA(1) = RDATA(1)/10.0
      CALL CODE 
      READ(JVALU,510) RDATA(2)
      RDATA(2) = RDATA(2)/1000.0
      RETURN
C 
600   CALL CODE 
      READ(IVALU,110) RDATA 
      IF (IS .EQ. 1 .OR. IS .EQ. 5) RDATA = -RDATA
      RDATA = RDATA/1000.0
      RETURN
C 
800   MRBUF(3) = 2H00 
      IS = 0
      GOTO 100
C 
1100  CALL CODE 
      READ (IVALU,110) RDATA
      RDATA = (RDATA/10000.0) - 4.0 
      RETURN
C 
C  PUT 1E38 INTO ERRONEOUS VALUES 
C 
9000  RDATA = 1.0E38
      RDATA(2) = 1.0E38 
      RETURN
      END 
      END$