C   07/06/96 606071842  MEMBER NAME  DIDA     (S4)          FORTRAN
      SUBROUTINE DIDA(IGOTO,LIST,IL)
C
C     VERSION OF JULY 82
C
      COMMON/ACS/DUMMI(90),NUNTB
C
C     IGOTO =-1   RESERVE DATA SET FOR EXCLUSIVE USE
C     IGOTO = 0   CREATE MASTER DIRECTORY BANK
C     IGOTO = 1   SEARCH FOR NAME,NR IN DIRECTORY RECORDS
C     IGOTO = 2   DELETE NAME,NR IN DIRECTORY RECORD
C     IGOTO = 3   ADD NAME,NR TO DIRECTORY RECORD
C
C     LIST(1) = NAME
C     LIST(2) = NR
C     LIST(3) = NR OF DATA RECORD
C     LIST(4) = NR OF WORDS IN BANK

      COMMON/BCS/IW(1)
      COMMON/CCS/IUND,INDT,INDC,NPTR,INDA,LISTE(5),IPAS,NDAREC
      INTEGER LIST(5,1),IBOS/'BOSS'/,DIRA/'DIRA'/,BINTIM
      JPAS=IPAS
      IPAS=0
      IF(IGOTO.LT.0) GOTO 80
    1 INDA=ILINK(4H+DIR,IUND)
      IF(INDA.EQ.0)  GOTO 10
      IF(IGOTO.GE.0) GOTO 14
      IPRFLG=0
      IF(IW(INDA+20).EQ.0) JPAS=IW(INDA+19)
      GOTO 11
C
C     CREATE MASTER DIRECTORY BANK (FROM DATA SET), IF NOT YET EXISTING
C
   10 INDA=IBANK(4H+DIR,IUND,52)
      IPRFLG=1
      IF(INDA.EQ.0) GOTO 202
   11 CALL RDDA(1,50,IW(INDA+1))
      IW(INDA+ 9)=0
      IW(INDA+10)=0
      IF(IPRFLG.EQ.0) GOTO 15
      IF(NUNTB.NE.0)
     1  WRITE(NUNTB,101) IUND,IW(INDA+6),IW(INDA+7),(IW(INDA+J),J=21,35)
C     READ LAST RECORD, TO CHECK DEFINE FILE STATEMENT
      CALL ERRSET(232,1,1,0,0,232)
      CALL RDDA(IW(INDA+6),1,DUMMY)
C
C     CHECK PASSWORD (IW(INDA+20)=1 MEANS NO CHANGE POSSIBLE)
C
   15 IF(IW(INDA+19).EQ.0)    GOTO 12
      IF(IW(INDA+19).EQ.JPAS) GOTO 12
      IF(JPAS.EQ.IBOS)        GOTO 12
      IW(INDA+19)=0
      IW(INDA+20)=1
      IF(NUNTB.NE.0.AND.IPRFLG.EQ.1) WRITE(NUNTB,102) IUND
      GOTO 14
   12 IW(INDA+20)=0
C
C     CONSISTENCY CHECKS AND BRANCH
C
   14 IF(IW(INDA+2).EQ.DIRA)       GOTO 16
      IF(IW(INDA+2).NE.IW(INDA-3)) GOTO 203
   16 IF(IW(INDA+11).EQ.0) IW(INDA+11)=1610
      NDAREC=IW(INDA+11)
      IF(IGOTO.LE.0) GOTO 100
      IF(IGOTO.EQ.3) GOTO 40
C
C     SEARCH FOR ENTRY IN DIRECTORY RECORDS
C
   20 INDT=0
      NHASH=2+MOD(IABS(LIST(1,1)+LIST(2,1)),IW(INDA+8))
      IA=IBANK(0,0,0)
      IF(IW(IA).LT.NDAREC) GOTO 201
   22 CALL RDDA(NHASH,NDAREC,IW(IA))
      NHASHX=IW(IA+3)
      INDP=IA+4
      K=INDP
      N=IW(K)/4
      IF(N.EQ.0)              GOTO 26
      IF(N.LT.0.OR.N.GT.(NDAREC-10)/4)  GOTO 201
      DO 24 I=1,N
      IF(LIST(1,1).NE.IW(K+1)) GOTO 24
      IF(LIST(2,1).NE.IW(K+2)) GOTO 24
C
C     ENTRY IN DIRECTORY RECORDS FOUND
C
      LIST(3,1)=IW(K+3)
      LIST(4,1)=IW(K+4)
      INDT=K
      IF(IGOTO-1) 100,100,30
   24 K=K+4
   26 NHASH=NHASHX
      IF(NHASH.NE.0) GOTO 22
      GOTO 100
C
C     DELETE NAME,NR FROM DIRECTORY RECORD
C
   30 NWCP=INDP+IW(INDP)-K-4
      IF(NWCP.NE.0) CALL UCOPY2(IW(K+5),IW(K+1),NWCP)
      IW(INDP)=IW(INDP)-4
      IW(IA)  =IW(IA)  -4
      CALL WRDA(NHASH,IW(IA),IW(IA+1))
      GOTO 100
C
C     ADD NAME,NR TO DIRECTORY RECORD
C
   40 NHASHF=0
      NHASHL=0
      IA=IBANK(0,0,0)
      IF(IW(IA).LT.NDAREC) GOTO 202
      I=0
C
C     LOOP FOR IL DIRECTORY ENTRIES
C
   50 I=I+1
      IF(I.GT.IL)         GOTO 70
      NHASH=2+MOD(IABS(LIST(1,I)+LIST(2,I)),IW(INDA+8))
      IF(NHASH.EQ.NHASHF) GOTO 56
      NHASHF=NHASH
   52 IF(NHASHL.EQ.0)     GOTO 54
      CALL WRDA(NHASHL,IW(IA),IW(IA+1))
      NHASHL=0
   54 CALL RDDA(NHASH,NDAREC,IW(IA))
   56 INDP=IA+4
      N=IW(INDP)/4
      IF(N.GE.(NDAREC-10)/4)        GOTO 60
C
C     COPY 4 WORDS INTO DIRECTORY
C
      CALL UCOPY(LIST(1,I),IW(INDP+IW(INDP)+1),4)
      IW(INDP)=IW(INDP)+4
      IW(IA)  =IW(IA)  +4
      NHASHL=NHASH
      GOTO 50
C
C     TRY NEXT DIRECTORY RECORD
C
   60 IF(IW(IA+3).EQ.0) GOTO 62
      NHASH=IW(IA+3)
      GOTO 52
C
C     NEW DIRECTORY RECORD REQUIRED
C     WHAT HAPPENS, IF SPACE ON DATA SET NO SUFFICIENT FOR LOAD
   62 NHASHL=NHASH
      IW(INDA+7)=IW(INDA+7)+1
      NHASH=IW(INDA+7)
C
C     SAVE TWO WORDS FROM DIRECTORY RECORD
C
      NTOT=IW(IA)
      NWDR=IW(IA+4)
C
C     WRITE NEW DIRECTORY RECORD
C
      IW(IA)=4
      IW(IA+4)=0
      CALL WRDA(NHASH,IW(IA),IW(IA+1))
C
C     WRITE EMPTY DATA RECORD
C
      IW(INDA+7)=IW(INDA+7)+1
      IW(IA)=0
      CALL WRDA(NHASH+1,IW(IA),IW(IA+1))
C
C     RESTORE TWO WORDS AND ADD POINTER TO NEXT DIRECTORY RECORD
C
      IW(IA)  =NTOT
      IW(IA+3)=NHASH
      IW(IA+4)=NWDR
      GOTO 52
C
C     FINAL WRITE FOR LAST DIRECTORY RECORD
C
   70 IF(NHASHL.EQ.0) GOTO 100
      CALL WRDA(NHASHL,IW(IA),IW(IA+1))
      GOTO 100
C
C     RESERVE DATA SET FOR EXCLUSIVE USE
C
   80 IA=IBANK(0,0,0)
      IF(IW(IA).LT.NDAREC) GOTO 201
C
C     TRY TO RESERVE DATA SET FOR EXCLUSIVE USE
C
C     LOOP FOR THIS OFFLINE VERSION ONLY UP TO 12*13 SEC
C
      DO 84 I=1,12
      CALL RDDA(2,50,IW(IA))
      CALL RDDA(1,50,IW(IA))
      ITIME=BINTIM(I)
      IF(IW(IA+ 8).NE.0)        GOTO 82
      IF(IW(IA+ 9).NE.0)        GOTO 82
   81 IW(IA+ 8)=LISTE(1)
      IW(IA+ 9)=LISTE(2)
      IW(IA+11)=ITIME
      CALL WRDA(1,IW(IA),IW(IA+1))
      CALL RDDA(2,50,IW(IA))
      CALL RDDA(1,50,IW(IA))
      IF(IW(IA+ 8).NE.LISTE(1)) GOTO 82
      IF(IW(IA+ 9).NE.LISTE(2)) GOTO 82
      GOTO 1
C
C     DATA SET IN USE, TRY AGAIN
C
   82 JTIME=IW(IA+11)
      IDTIME=IABS(ITIME-JTIME)
      IF(NUNTB.NE.0) WRITE(NUNTB,104) IDTIME
  104 FORMAT(1X,'DATA SET RESERVED, TIME DIFFERENCE IS',I10,'/100 SEC')
C     ASSUME FREE, IF MORE THAN 3 MIN TIME DIFFERENCE
      IF(IABS(IDTIME).GT.18000) GOTO 81
C     WAIT  13 SEC (=500000*26 MIKROSEC)
      CALL DELAY(500000)
   84 CONTINUE
   90 IF(NUNTB.NE.0) WRITE(NUNTB,103) IUND
      GOTO 201
C
C
  100 RETURN
  101 FORMAT('0---- DIR-UNIT',I3,9X,'TOTAL',I6,' RECORDS, USED',
     1   I6,' RECORDS'/'0',38X,'LAST LOAD',17X,'LAST UPDATE',17X,
     2   'LAST UNLOAD'/15X,' DATE',10X,3(2A4,2X,2A4,10X)/
     3   15X,' STORED BANKS',12X,3(I8,20X)/)
  102 FORMAT('0---- DIR-UNIT',I3,9X,'PROTECTED DATA SET, NO BCREDA',
     1   ' OR BDLSDA POSSIBLE'/)
  103 FORMAT('0---- DIR-UNIT',I3,' IN USE, NO CHANGE POSSIBLE - STOP'/)
C
C     ERROR - DATA SET IN USE
C
  201 CALL BDMPA(15)
C
C     INSUFFICIENT SPACE FOR DIRAC OPERATION
C
  202 CALL BDMPA(16)
C
C     ILLEGAL DIRECTORY
C
  203 CALL BDMPA(17)
      GOTO 100
      END
