SUBROUTINE DBFDI(IREC,POS,IOFF,NAME,LENGTH,LDOC,TYPE,NEW,ECODE)
      PARAMETER (IPW=64,IPINDX=10)
      IMPLICIT INTEGER(A-Z)
C
C     FIND A DIRECTORY FIELD FOR  NAME  IN THE CURRENTLY OPEN DATABANK.
C     (SEARCH THE LINKED LIST STRUCTURE, LOOKING FOR  NAME  , AND ALSO
C      MAKE SURE THAT THE POSITION FOUND HAS ENOUGH ROOM FOR  LENGTH
C      REAL*4 WORDS OF DATA).
C     INPUT:
C     LENGTH = 0   WHEN SEARCHING READONLY
C            > 0   WHEN SEARCHING TO INSERT/REPLACE
C     OUTPUTS:
C     POS    = POINTER TO FIRST RECORD FOR WRITING OR READING DATA
C     IOFF   = OFFSET TO RECORD FOR WRITING OR READING DATA
C     LENGTH = ACTUAL LENGTH   WHEN SEARCHING READONLY
C     TYPE   = ACTUAL TYPE     WHEN SEARCHING READONLY
C     NEW = -1  WHEN NAME WAS FOUND.  (INDEX MODIFIED IF LENGTH>0 AND NO FIT).
C         =  0  WHEN NAME WAS NOT FOUND.  (NAME PUT INTO INDEX IF LENGTH>0).
C
      COMMON /IOCOM/ NOTIO,OUNIT
      LOGICAL IFCOMP,IFREAD,IFSKIP,IFBLNK
      INTEGER NAME(2),VNAME(2),IREC(IPW)
      INTEGER*2 ECODE,TYPE,IOFF,NXTOFF,NINDEX,
     * I2VAL(2),VTYPE
      EQUIVALENCE (I4VAL,I2VAL)
C
C....FIND A DIRECTORY FIELD FOR  NAME
C
C....NEXTRC IS THE POSITION OF THE NEXT DIRECTORY POINTER (FOR NXTOFF=0)
C
      IFREAD = LENGTH.EQ.0
C
C....LOOP OVER INDEX RECORDS
C
      POS = 1
      IFSKIP = .FALSE.
   10 CONTINUE
      CALL DBGET(POS,IREC,ECODE)
      IF (ECODE.NE.0) THEN
        WRITE(OUNIT,901)
  901   FORMAT(' ERROR IN TSP DATABANK:  DBFDI NEAR LABEL 10')
        NEW = 0
        RETURN
      ENDIF
      I4VAL = IREC(2)
      NXTOFF = I2VAL(1)
      NINDEX = I2VAL(2)
      IF (IFSKIP) GOTO 21
C
C....LOOP OVER INDEX ENTRIES  (NOTE: NINDEX > 0 ALWAYS ON INITIALIZATION)
C
C
      DO 20 I=1,NINDEX
        CALL DBGDI(IREC(5),I,POS1,IOFF,VNAME,VLENG,VLDOC,VTYPE)
        IF (VTYPE.EQ.0) THEN
          IF (IFBLNK(VNAME)) GOTO 20
        ENDIF
C
C....NAME HERE ALREADY WITH EQUAL LENGTH ?
C
        IF (IFCOMP(NAME,VNAME)) THEN
          IF (IFREAD .OR. LENGTH.EQ.VLENG .OR.
     *        (I.EQ.NINDEX .AND. NXTOFF.GT.0) ) THEN
C
C....       SET UP OUTPUT ARGUMENTS
C
            IF (IFREAD) THEN
              LENGTH = VLENG
              TYPE = VTYPE
              LDOC = VLDOC
            ELSE
              IF (LENGTH.NE.VLENG .OR. LDOC.NE.VLDOC .OR.
     *            TYPE.NE.VTYPE) THEN
C
C               HERE WE HANDLE THE SPECIAL CASES OF:
C               1. LENGTHENING OR SHORTENING THE LAST VARIABLE
C                  IN THE DATABANK.
C               2. CHANGING THE TYPE OF ANY VARIABLE WHOS LENGTH
C                  REMAINS THE SAME.
C
                OLDLEN = VLENG
                VLENG = LENGTH
                VLDOC = LDOC
                VTYPE = TYPE
                CALL DBPDR(IREC(5),I,POS1,IOFF,VNAME,VLENG,VLDOC,VTYPE)
C
C               COMPUTE POINTER TO NEXT FREE SPACE FOR DATA
C               (RECORD AND OFFSET)
C               NRECS = INCREMENT FOR NEXT RECORD POINTER
C               (CODE TAKEN FROM DBPDI)
C
                IF (OLDLEN.NE.LENGTH) THEN
                  LOFF = NXTOFF + LENGTH-OLDLEN
C
C                 HANDLE LOFF NON-POSITIVE (FINAL VARIABLE SHRINKS)  7/98
C
                  IF (LOFF.GT.0) THEN
                    NRECS = (LOFF-1)/IPW
                  ELSE
                    NRECS = -1 + LOFF/IPW
                  ENDIF
                  NEXTRC = IREC(1) + NRECS
                  NXTOFF = LOFF - NRECS*IPW
                  IREC(1) = NEXTRC
                  I2VAL(1) = NXTOFF
C                  I2VAL(2) = NINDEX
                  IREC(2) = I4VAL
C
C                 IF DATA LENGTH OF THIS FINAL ITEM IS INCREASING,
C                 AND THE FINAL RECORD IS A PARTIAL RECORD, WRITE
C                 A FAKE DATA RECORD THERE, SO THAT DBPUT2 WILL BE
C                 ABLE TO READ IT (SAME AS CODE IN DBPDI)  9/03
C
                  IF (NRECS.GT.0 .AND. NXTOFF.GT.1) THEN
                    CALL DBPUT(NEXTRC,IREC,ECODE)
                  ENDIF
                ENDIF
C
C               UPDATE INDEX RECORD
C
                CALL DBPUT(POS,IREC,ECODE)
              ENDIF
            ENDIF
            POS = POS1
            NEW = -1
            RETURN
C
C....NAME HERE,  BUT LOCATION IS TOO SMALL OR LARGE.
C....DELETE THIS FIELD AND THE DATA BY BLANKING THE NAME AND SETTING THE
C     TYPE=0, BUT LEAVE THE POINTERS.
C....SET A FLAG TO SKIP TO THE LAST INDEX RECORD.
C    NOTE:  NEW = 0  ON RETURN, BUT NEW IS ONLY USED ON RETURN FOR LENGTH=0.
C
          ELSE
            CALL BLANKN(VNAME)
            VTYPE = 0
            CALL DBPDR(IREC(5),I,POS1,IOFF,VNAME,VLENG,VLDOC,VTYPE)
C           UPDATE NWASTE
            IREC(3) = IREC(3) + VLENG
            CALL DBPUT(POS,IREC,ECODE)
            IFSKIP = .TRUE.
            GOTO 21
          ENDIF
        ENDIF
C
   20 CONTINUE
C
   21 IF (NXTOFF.GT.0) GOTO 30
      POS = IREC(1)
      GOTO 10
C
C.... VARIABLE NOT FOUND IN ANY INDEX RECORDS
C
   30 CONTINUE
      IF (.NOT.IFREAD)
     * CALL DBPDI(IREC,POS,IOFF,NAME,LENGTH,LDOC,TYPE,ECODE)
      NEW = 0
      RETURN
      END