FTN4,L
      SUBROUTINE ANARD(ITYPE,IFRST,NUMBR,RVALU),
     +09580-16468 REV.2026 800212 
C 
C-------------------------------------
C 
C  SCHLUMBERGER 1172 FREQUENCY RESPONSE ANALYZER
C 
C  RELOCATABLE 09580-16468
C  SOURCE      09580-18468
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 TO RETURN DATA TO THE 
C   CALLING PROGRAM.  THE DATA WAS CREATED AND STORED USING THE 
C   1172 DEVICE SUBROUTINE CALL 'ANAME'.  THE DATA IS READ FROM 
C   FILE 'D1172::-3' (TYPE 1 FILE). 
C 
C  HARDWARE REQUIRED: 
C  ------------------ 
C    A. SCHLUMBERGER 1172 WITH 1183-C INTERFACE UNIT
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    ANARD(I,I,I,RAV),  OV=XX,   ENT=ANARD,   FIL=%ANARD
C 
C  CONFIGURATION TABLE ENTRIES: 
C  ---------------------------- 
C 
C    NONE REQUIRED
C 
C 
C 
C 
C------------------------------------ 
C 
C  ANARD(ITYPE,IFRST,NUMBR,RVALU) 
C 
C    WHERE: 
C 
C       ITYPE = DESIRED DATA TYPE TO BE READ FROM THE DISC FILE 
C               01 = A(X) 
C               02 = A(Y) 
C               03 = A(Y/X) 
C               04 = B(X) 
C               05 = B(Y) 
C               06 = B(Y/X) 
C               07 = R(X) 
C               08 = R(Y) 
C               09 = R(Y/X) 
C               10 = THETA (X) - DEGREES
C               11 = THETA (X) - RADIANS
C               12 = THETA (Y) - DEGREES
C               13 = THETA (Y) - RADIANS
C               14 = THETA (Y/X) - DEGREES
C               15 = THETA (Y/X) - RADIANS
C               16 = LOG R(X) 
C               17 = LOG R(Y) 
C               18 = LOG R(Y/X) 
C               19 = REJECT BIAS
C               20 = DISPLAYED FREQUENCY
C               21 = LOG F
C 
C       IFRST = FIRST READING OF TYPE IN FILE TO BE RETURNED
C               MINIMUM = 1 
C               MAXIMUM = # RECORDS IN 'D1172' (SEE &ANARD) 
C 
C       NUMBR = NUMBER OF READINGS OF TYPE TO BE RETURNED 
C               MINIMUM = 1 
C               MAXIMUM = (# RECORDS IN 'D1172) - IFRST 
C 
C       RVALU = RETURNED VALUE ARRAY
C 
C  THE DATA IS STORED IN A TYPE 1 FILE CALLED 'D1172::-3' IN A
C  21 X 200 ARRAY FORMAT.  THE DATA IS STORED IN THE FILE BY THE
C  'ANAME' CALL.  FILE 'D1172' IN THIS EXAMPLE IS ASSUMMED TO BE 200
C  RECORDS LONG.
C 
C  FOR EXAMPLE: 
C 
C              10 DIM A(200), B(200)
C              .
C              .
C              100 CALL ANAME(1,0,1)
C              110 REM GET FIRST 50 A(X) READINGS 
C              120 CALL ANARD(1,1,50,A(1))
C              130 REM GET FIRST 50 R(X) READINGS 
C              140 CALL ANARD(7,1,50,B(1))
C              150........... 
C              .
C              .
C 
C 
C------------------------------------ 
C 
      DIMENSION IERMS(5),RVALU(200) 
      DATA IERMS / 10,5,2HAN,2HAR,2HD  /
C 
      IERMS=10
C 
C 
C  CALL X SUB 
C 
      CALL XNARD(IERMS,ITYPE,IFRST,NUMBR,RVALU) 
      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 XNARD(IERMS,ITYPE,IFRST,NUMBR,RVALU),
     +09580-16468 REV.2026 800212 
C 
      DIMENSION IERMS(5),IOBUF(12),IDCB(144),STBUF(64),ISTBF(128) 
      DIMENSION INAME(3),RVALU(200) 
C 
      EQUIVALENCE (STBUF(1),ISTBF(1)) 
C 
      DATA INAME /2HD1,2H17,2H2 / 
C 
C 
C 
C---------------------------------------------
C 
C 
C 
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 = DATA FILE ACCESS ERROR 
C        3 = EXEC CALL ERROR
C        4 = ATTEMPTED TO READ DATA OUTSIDE OF FILE LIMITS
C        9 = EXEC CALL REJECTED 
C 
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(ITYPE .LT. 1 .OR. ITYPE .GT. 21) GOTO 8000 
      IF(IFRST .LT. 1) GOTO 8000
      IF(NUMBR .LT. 1) GOTO 8000
      IERMS = 0 
C 
C  LOCK SUBROUTINE INTO MEMORY
C 
      CALL EXEC(100000B+22,1) 
      GOTO 9000 
50    CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8600 
C 
C  OPEN DATA BUFFER 
C 
      CALL OPEN(IDCB,IERR,INAME,3,0,-3) 
      IF (IERR .NE. 1) GOTO 8500
C 
C  POSITION TO PROPER RECORD
C 
      CALL POSNT(IDCB,IERR,IFRST,1) 
      IF (IERR .EQ. -12) GOTO 8700
      IF (IERR .LT. 0) GOTO 8500
C 
C  READ DATA FROM FILE AND PLACE IN RETURN ARRAY
C 
      DO 100 ICNT = 1,NUMBR 
      CALL READF(IDCB,IERR,ISTBF) 
      IF (IERR .EQ. -12) GOTO 8700
      IF (IERR .LT. 0) GOTO 8500
      RVALU(ICNT) = STBUF(ITYPE)
100   CONTINUE
C 
C  GO TO RETURN 
C 
      GOTO 9900 
C 
C  ERROR RETURN 
C 
8500  IERMS=2 
      GOTO 8000 
8600  IERMS = 3 
      GOTO 8000 
8700  IERMS = 4 
      GOTO 8000 
9000  IERMS = 9 
8000  IERMS(2)=5
      IERMS(3)=2HAN 
      IERMS(4)=2HAR 
      IERMS(5)=2HD
C 
C  CLOSE FILE 
C 
9900  CALL CLOSE(IDCB)
C 
C  REENABLE SWAPPING
C 
      CALL EXEC(22,0) 
C 
C  RETURN TO CALLING PROGRAM
C 
      RETURN
      END 
      END$
                                                                  