SUBROUTINE DBPDI(IREC,POS,IOFF,NAME,LENGTH,LDOC,TYPE,ECODE)
      PARAMETER (IPW=64,IPINDX=10)
      IMPLICIT INTEGER(A-Z)
C
C     PUT DIRECTORY INFO FOR  NAME  INTO THE DATABANK AT RECORD POS.
C     DBFDI HAS ALREADY BEEN CALLED TO POSITION POS AT THE LAST INDEX REC.
C       THE RECORD HAS ALSO BEEN READ INTO IREC()
C     OUTPUTS:
C     POS = POINTER TO RECORD WHERE DATA IS TO BE WRITTEN TO.
C     IOFF = OFFSET IN RECORD WHERE DATA STARTS.
C
      COMMON /IOCOM/ NOTIO,OUNIT
      INTEGER NAME(2),IREC(IPW)
      INTEGER*2 TYPE,ECODE,IOFF,NXTOFF,NINDEX,I2VAL(2)
      EQUIVALENCE (I4VAL,I2VAL)
C
      NEXTRC = IREC(1)
      I4VAL  = IREC(2)
      NXTOFF = I2VAL(1)
      NINDEX = I2VAL(2)
C
C     THE CALLING ROUTINE GUARANTEES THAT THIS IS THE LAST INDEX RECORD,
C     SO IF ALL THE INDEX ENTRIES ARE USED, WE MUST CREATE A NEW RECORD.
C
      IF (NINDEX.LT.IPINDX) GOTO 30
C
C     UPDATE CURRENT INDEX RECORD
C     (MAKE NEXTRC POINT TO THE NEW INDEX RECORD, WITH NXTOFF=0)
C
      IF (NXTOFF.GT.1) NEXTRC = NEXTRC+1
      IREC(1) = NEXTRC
      NXTOFF = 0
      I2VAL(1) = NXTOFF
      IREC(2) = I4VAL
      CALL DBPUT(POS,IREC,ECODE)
      IF (ECODE.NE.0) THEN
        ILOC = 20
        GOTO 900
      ENDIF
C
C     INITIALIZE NEW INDEX RECORD (NEXTRC POINTS TO A DATA RECORD NOW)
C
      POS = NEXTRC
      NEXTRC = NEXTRC+1
      NXTOFF = 1
      NINDEX = 0
      NWASTE = 0
      IREC(3) = NWASTE
C
C     APPEND TO CURRENT INDEX RECORD
C
   30 NINDEX = NINDEX+1
      J = NINDEX
      CALL DBPDR(IREC(5),J,NEXTRC,NXTOFF,NAME,LENGTH,LDOC,TYPE)
      POS0 = NEXTRC
      IOFF = NXTOFF
C
C     COMPUTE POINTER TO NEXT FREE SPACE FOR DATA (RECORD AND OFFSET)
C     NRECS = INCREMENT FOR NEXT RECORD POINTER
C
      LOFF = NXTOFF + LENGTH
      NRECS = (LOFF-1)/IPW
      NEXTRC = NEXTRC + NRECS
      NXTOFF = LOFF - NRECS*IPW
C
C     UPDATE INDEX RECORD
C
      IREC(1) = NEXTRC
      I2VAL(1) = NXTOFF
      I2VAL(2) = NINDEX
      IREC(2) = I4VAL
      CALL DBPUT(POS,IREC,ECODE)
      IF (ECODE.NE.0) THEN
        ILOC = 40
        GOTO 900
      ENDIF
C
C     WRITE THE LAST DATA RECORD IF IT IS PARTIALLY FILLED AND NEW SO THAT
C     IT CAN BE READ IN DBPUT2.
C
      IF (NXTOFF.GT.1 .AND. (IOFF.EQ.1 .OR. LOFF.GT.IPW))
     * CALL DBPUT(NEXTRC,IREC,ECODE)
C
      POS = POS0
      RETURN
C
  900 WRITE(OUNIT,901) ILOC
  901 FORMAT(' ERROR IN TSP DATABANK:  DBPDI NEAR LABEL ',I2)
      RETURN
      END