      SUBROUTINE DKBFPS(IH,IBYTE,IPOS,IB,ISTAT)
C
C     POSITION FOR BUFFERED READ OR WRITE
C
C     IH- FILE HANDLE
C     IBYTE- BYTE POSITION TO POSITION FILE TO 1=FIRST BYTE IN FILE
C     IPOS- RESULANT BYTE POSITION AFTER OPERATION
C
C >>>>>>> NOTE: IBYTE AND IPOS MUST BE I*4 <<<<<<
C               IF CALLED WITH IBYTE EQ 0 RETURNS CURRENT POSITION
C                                    EQ -1 POSITIONS TO EOF
C     IB- BUFFER USED TO READ
C        MUST BE (# OF BYTES/2) + 10   IN LENGTH(16 BIT WORDS)
C        MUST BE PRE SET BY CALL TO PCOPEN
C        DO NOT CHANGE AFTER FIRST USE !!!!!!
C     ISTAT- RETURN STATUS  0= OK
C                          .NE.0 = ERROR
C
C
C      IB(1)- UNIQUE FLAG SET AFTER FIRST USE
C      IB(2)- START WORD OF TRANSFER AREA
C      IB(3)- TOTAL WORDS IN BUFFER
C      IB(4)- OUT BYTE POINTER
C      IB(5)- IN BYTE POINTER (NEXT FREE BYTE)
C      IB(6)- READ/WRITE FLAG 1=READ/-1=WRITE
C      IB(7)- ACTUAL FILE BYTE LOC OF CURRENT BUFFER
C      IB(8)- IH FILE HANDLE
C      IB(9)- LENGTH OF TRANSFER AREA IN BYTES
C      IB(10)- STARTING BYTE LOCATION OF TRANSFER AREA
C
C
C
C
      INTEGER IB(2058)
      INTEGER*4 IBYTE,IPOS,JBYTE
C
C
      DATA JUNIQ/3566/
C
C
C     TEST FOR INIT OF BUFFER
C
      IF(IB(1).NE.JUNIQ) THEN
C
      ISTAT=-3
      GO TO 800
      ENDIF
C
C     CHECK FOR WRITE BUFFER
C
      IF(IB(6).LT.0) THEN
C
C     CHECK FOR NON-EMPTY BUFFER
C
      IF(IB(5).GT.IB(4)) THEN
      N= IB(5) - IB(4)
      CALL WRITF(IH,IB(IB(2)), N, ISTAT, NTT)
      IF(N.NE.NTT) THEN
      ISTAT=-1
      GO TO 800
      ENDIF
      ENDIF
      ENDIF
C
C     PROCESS
C
      IF(IBYTE.GT.0) THEN
      JBYTE=IBYTE-1
      CALL SEEKF(IH,0,JBYTE,IPOS,ISTAT)
      IF(ISTAT.NE.0) GO TO 800
C
C
C     WRITE(*,*)' READF JS,NT ',JS,NT
C
C
C
C     UPDATE NEW BUFFER POINTERS
      IB(5)=IB(10)
      IB(4)=IB(10)
C
C     CHECK FOR IBYTE LT 1
C
      ELSE IF(IBYTE.EQ.0) THEN
      JBYTE=0
      CALL SEEKF(IH,1,JBYTE,IPOS,ISTAT)
      IF(ISTAT.NE.0) GO TO 800
C
      ELSE IF(IBYTE.EQ.-1) THEN
C     FIND END-OF-FILE
      CALL SEEKF(IH,2,JBYTE,IPOS,ISTAT)
      IF(ISTAT.NE.0) GO TO 800
C
C     WRITE(*,*)(IB(IP),IP=1,10)
C
      ELSE IF(IBYTE .EQ. -2) THEN
C       * return the file address corresponding to the buffer position
        JBYTE=0
        CALL SEEKF(IH,1,JBYTE,IPOS,ISTAT)
        IF (ISTAT .NE. 0) THEN
          GO TO 800
        ELSE
          IPOS = IPOS - IB(5) + IB(4)
        ENDIF
      ENDIF
      IPOS=IPOS+1
      ISTAT=0
 800  CONTINUE
      RETURN
      END
