C   07/06/96 606071814  MEMBER NAME  BFTDIR   (S4)          FORTRAN
      SUBROUTINE BFTDIR(LUN,LUN1,IOPT)
C
C     VERSION JULY 82
C
      COMMON/ACS/DUMMI(90),NUNTB
      COMMON/BCS/IW(1)
      COMMON/CCS/IUND,INDT,INDC,NPTR,INDA,LISTE(5),IPAS,NDAREC
      REAL*8 DATE(2)
      INTEGER IOPFR/2HFR/,IOPTO/2HTO/,IOPT0/2HT0/,BLANK/4H    /
      INTEGER DIRA/'+DIR'/,DIRO/'DIRA'/
      CALL DAY(DATE(1),DATE(2))
      IOP=0
      IF(IOPT.EQ.IOPFR) IOP=1
      IF(IOPT.EQ.IOPTO) IOP=2
      IF(IOPT.EQ.IOPT0) IOP=2
      IF(NUNTB.NE.0) WRITE(NUNTB,101) LUN,LUN1,IOPT
      IF(IOP.EQ.0) GOTO 201
      IUND=LUN
      CALL DIDA(0,LISTE,1)
      IF(INDA.EQ.0) GOTO 202
      IF(IOP.NE.1)  GOTO 20
C
C     OPTION FR=FROM
C
      IF(IW(INDA+34).NE.0) GOTO 201
      IF(IW(INDA+20).EQ.1) GOTO 201
C
C
C
      INDL=IBANK(4H+DIR,-1,2000)
      IF(INDL.EQ.0)     GOTO 201
      INDB=IBANK(4H+DIR,-2,3204)
      IF(INDB.EQ.0)     GOTO 201
      NREC=IW(INDA+6)
      NBK=0
      N=0
      NCT=0
      NERR=0
C
C     READ SEQUENTIAL DATA SET
C
      IF(LUN1.EQ.0) GOTO 18
   10 CALL RDSQ(LUN1,NTOT,IW(INDB+1),&16)
      NCT=NCT+1
      IF(NTOT.LE.0.OR.NTOT.GT.3204) GOTO 12
      IF(NTOT-4.NE.IW(INDB+4)) GOTO 12
      GOTO 14
   12 NERR=NERR+1
      GOTO 10
   14 IF(NCT.EQ.0) GOTO 16
      LISTE(1)=IW(INDB+1)
      LISTE(2)=IW(INDB+2)
      LISTE(3)=0
      LISTE(4)=IW(INDB+4)
      LISTE(5)=2+MOD(IABS(LISTE(1)+LISTE(2)),IW(INDA+8))
      INDC=INDB+4
      CALL DAFR(3)
      CALL UCOPY2(LISTE,IW(INDL+5*N+1),5)
      NBK=NBK+1
      N=N+1
      IF(N.LT.400) GOTO 10
   16 IF(N.EQ.0) GOTO 18
      CALL SORTAE(IW(INDL+1),5,N,5,0)
      CALL DIDA(3,IW(INDL+1),N)
      IF(N.NE.400) GOTO 18
      N=0
      GOTO 10
   18 IW(INDA+33)=NBK
      IW(INDA+34)=NBK
      IW(INDA+35)=NBK
      CALL WRDA(1,IW(INDA+1),IW(INDA+2))
      NCT=NCT-NERR
      IND =IBANK(4H+DIR,-2,2HDL)
      IND =IBANK(4H+DIR,-1,2HDL)
      IPAS=IW(INDA+19)
      INDA=IBANK(4H+DIR,IUNDA,2HDL)
      CALL DIDA(0,LISTE,1)
      CALL BGAR(IGA)
      IF(NUNTB.NE.0) WRITE(NUNTB,102) LUN,NCT,NERR
      IF(LUN1.NE.0) REWIND LUN1
      GOTO 100
C
C     OPTION TO
C
   20 NPAGL=200
      IPAS=0
      INDA=ILINK(4H+DIR,IUND)
      IF(INDA.NE.0) IPAS=IW(INDA+19)
      INDA=IBANK(4H+DIR,IUND,2HDL)
      CALL BGAR(IGA)
C
C     DETERMINE NUMBER OF RECORDS
C
      CALL DIDA(0,LISTE,1)
      IF(INDA.EQ.0) GOTO 203
      NRECL=IW(INDA+7)
      CALL UCOPY(DATE,IW(INDA+29),4)
C
C     PREPARE BANK FOR TABLE OF CONTENT
C
      INDL=IBANK(4H+DIR,-1,450)
      IF(INDL.EQ.0) GOTO 201
      NPG=0
      NE =0
      NERR=0
      NSE=0
      IA=IBANK(0,0,0)
      IF(IW(IA).LE.3204+NDAREC) GOTO 201
      NRC=0
   24 NTOT=0
      IB=IA
   30 NRC=NRC+1
      ISW=0
      IF(NRC.LE.NRECL) GOTO 32
      ISW=2
      GOTO 50
C
C     READ NEXT RECORD FROM DIRECT ACCESS
C
   32 JSAV=IW(IB-1)
      CALL RDDA(NRC,NDAREC,IW(IB-1))
      NTOTN=IW(IB-1)
      IW(IB-1)=JSAV
      IF(NTOTN.EQ.0) GOTO 36
      IF(NTOTN.GT.4.AND.NTOTN.LE.NDAREC-1) GOTO 34
      NERR=NERR+1
      GOTO 24
   34 IF(IW(IB).NE.DIRA.AND.IW(IB).NE.DIRO) GOTO 40
   36 ISW=1
      GOTO 50
   40 NTOT=NTOT+NTOTN
      IF(IA.EQ.IB) GOTO 50
C
C     COMPARE NAME AND NR
C
      IF(IW(IA  ).NE.IW(IB)  ) GOTO 50
      IF(IW(IA+1).NE.IW(IB+1)) GOTO 50
C
C     EQUAL
C
      NW=IW(IB+3)
      CALL UCOPY2(IW(IB+4),IW(IB),NTOTN-4)
      NTOT=NTOT-4
      IW(IA+3)=IW(IA+3)+NW
C
   50 IND=IA+3
      IF(NTOT.EQ.0.AND.ISW.EQ.2) GOTO 66
      IF(NTOT.EQ.0) GOTO 24
   52 NW=IW(IND)
      IF(NW.LE.0) GOTO 54
      IF(IA+NTOT-1-IND-NW) 54,56,60
C     ERROR
   54 CONTINUE
      GOTO 24
C     LAST BANK
   56 IF(ISW.NE.0) GOTO 60
      CALL UCOPY2(IW(IND-3),IW(IA),NW+4)
      NTOT=NW+4
      IB=IA+NTOT
      ISW=0
      GOTO 30
   60 NWR=NW+4
      IF(LUN1.NE.0) CALL WRSQ(LUN1,NWR,IW(IND-3))
      NSE=NSE+1
      IF(NE.NE.0) GOTO 64
      DO 62 I=1,450
   62 IW(INDL+I)=BLANK
   64 JCOL=NE/50
      INDX=INDL+JCOL*3+(NE-JCOL*50)*3*3
      IW(INDX+1)=IW(IND-3)
      IW(INDX+2)=IW(IND-2)
      IW(INDX+3)=IW(IND)
      NE=NE+1
      IF(ISW.EQ.2) GOTO 66
      IF(NE.LT.150) GOTO 70
   66 IF(NPG.GE.NPAGL) GOTO 68
C
C     PRINT TABLE OF CONTENT
C
      NPG=NPG+1
      IF(NUNTB.NE.0) WRITE(NUNTB,103) LUN,NPG
      CALL PRINTA(IW(INDL+1),-3,450)
   68 IF(NE.EQ.150) NE=0
      IF(ISW.EQ.2) GOTO 90
   70 IND=IND+4+NW
      GOTO 52
   90 IF(INDA.EQ.0) GOTO 92
      IF(IUNTP.EQ.0) GOTO 92
      IF(IW(INDA+20).NE.0) GOTO 92
C
C     UPDATE DATE IN MASTER DIRECTORY
C
      LISTE(1)=DIRA
      LISTE(2)=DIRO
      CALL DIDA(-1,LISTE,1)
      CALL WRDA(1,IW(INDA+1),IW(INDA+2))
   92 IZER=IBANK(4H+DIR,-1,2HDL)
      CALL BGAR(IGA)
      IF(NUNTB.NE.0) WRITE(NUNTB,102) LUN,NSE,NERR
      IF(LUN1.NE.0) REWIND LUN1
C
  100 RETURN
  101 FORMAT('0---- DIR-UNIT',I3,0X,'SEQ-UNIT',I3,'   OPTION = ',A4,
     1   '  (BFTDIR START)')
  102 FORMAT('0---- DIR-UNIT',I3,I14,' RECORDS(=BANKS) COPIED,',I4,
     1   ' ILLEGAL RECORDS   (BFTDIR END)')
  103 FORMAT('1---- DIR-UNIT',I3,10X,'PAGE',I3/
     1   11X,3(8X,'NAME',6X,'NUMBER',1X,'NR OF WORDS')/)
  201 CALL BDMPA(47)
  202 CALL BDMPA(48)
  203 CALL BDMPA(49)
      GOTO 100
      END
