C   07/06/96 606071852  MEMBER NAME  INDDIR   (S4)          FORTRAN
      FUNCTION INDDIR(NAME,NR,IUNIT,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 IPR/0/,IOPTL(4)/2HFE,2HDL,2HST,2HFU/,NAMUN/4H+U00/
C
C     DIRECT ACCESS FUNCTION
C
      INDDIR=0
      IUND=IUNIT
      DO 10 IOP=1,4
      IF(IOPT.EQ.IOPTL(IOP)) GOTO 12
   10 CONTINUE
      GOTO 100
   12 LISTE(1)=NAME
      LISTE(2)=NR
      IF(IOP.EQ.4) GOTO 20
      IF(IOP-2) 20,30,40
C
C     FETCH FROM DIRECT ACCESS DATA SET
C
   20 INDC=ILINK(LISTE(1),LISTE(2))
      IF(INDC.NE.0) GOTO 90
      CALL DIDA(1,LISTE,1)
      IF(INDT.EQ.0) GOTO 100
      IF(IOP.NE.4) GOTO 26
   22 IND=IBLN(LISTE(1))
      IND=IW(IND)
      IF(IND.EQ.0) GOTO 26
      IF(IW(IND-1).EQ.0) GOTO 24
      IND=IBANK(LISTE(1),IW(IND-2),'DL')
      GOTO 22
   24 IND=ILINK(LISTE(1),IW(IND-2))
      IF(IW(IND).NE.LISTE(4)) GOTO 25
      INDC=IBANK(LISTE(1),LISTE(2),'RN')
      GOTO 28
   25 IND=IBANK(LISTE(1),IW(IND-2),'DL')
   26 INDC=IBANK(LISTE(1),LISTE(2),LISTE(4))
   28 IF(INDC.EQ.0) GOTO 100
      CALL DAFR(1)
C     IF BANK NOT FOUND DELETE DIRECTORY ENTRY
      IF(INDC.EQ.0) GOTO 30
      GOTO 90
C
C     DELETE BANK ON DIRECT ACCESS DATA SET
C
   30 JD=-1
C
C     MAKE SURE DIRECTORY BANK IS THERE AND CHECK PASSWORD
C
      CALL DIDA(0,LISTE,1)
      IF(IW(INDA+20).NE.0) GOTO 100
C
C     RESERVE DATA SET EXCLUSIVELY
C
      CALL DIDA(-1,LISTE,1)
C
C     CHECK, THAT BANK TO BE DELETED IS THERE
C
      CALL DIDA(1,LISTE,1)
      IF(INDT.NE.0) GOTO 35
      CALL WRDA(1,IW(INDA+1),IW(INDA+2))
      GOTO 100
   35 NPTR=IW(INDT+3)
C
C     DELETE BANK ON DATA SET AND IN DIRECTORY
C
      CALL DAFR(2)
      CALL DIDA(2,LISTE,1)
C
C     UPDATE BANK COUNTER AND PRINT
C
      IW(INDA+51)=IW(INDA+51)+1
      IF(NUNTB.EQ.0) GOTO 70
      IF(IW(INDA+51).LE.100) WRITE(NUNTB,104) IUND,LISTE(1),LISTE(2)
      IF(IW(INDA+51).EQ.100) WRITE(NUNTB,109) IUND
      GOTO 70
C
C     STORE BANK ON DIRECT ACCESS DATA SET
C
   40 JD=1
      INDC=ILINK(LISTE(1),LISTE(2))
      IF(INDC.EQ.0) GOTO 85
      IF(IW(INDC).LE.0) GOTO 85
      IF(IW(INDC).GT.3200) GOTO 85
C
C     MAKE SURE DIRECTORY BANK IS THERE AND CHECK PASSWORD
C
      CALL DIDA(0,LISTE,1)
      IF(IW(INDA+20).NE.0) GOTO 100
C
C     RESERVE DATA SET EXCLUSIVELY
C
      CALL DIDA(-1,LISTE,1)
C
C     SEARCH DIRECTORY FOR BANK
C
      CALL DIDA(1,LISTE,1)
C
C     CHECK TOTAL SPACE ON DATA SET
C
      IF(IW(INDA+7)+2+IW(INDC)/NDAREC.GT.IW(INDA+6)) GOTO 201
      ICO=1
      IF(INDT.EQ.0) GOTO 50
C
C     BANK IS ALREADY ON DATA SET
C
      IW(INDA+34)=IW(INDA+34)-1
      ICO=2
      IF(IW(INDC).EQ.LISTE(4)) GOTO 52
C
C     DELETE BANK ON DATA SET AND IN DIRECTORY
C
      CALL DAFR(2)
      CALL DIDA(2,LISTE,1)
C
C     ADD BANK TO DATA SET AND DIRECTORY
C
   50 CALL DAFR(3)
      CALL DIDA(3,LISTE,1)
      GOTO 54
C
C     INSERT BANK IN SAME PLACE ON DATA SET
C
   52 CALL DAFR(4)
C
C     UPDATE COUNTER AND PRINT
C
   54 IW(INDA+51)=IW(INDA+51)+1
      IF(IW(INDA+51).GT.100) GOTO 70
      GOTO (60,62),ICO
   60 IF(NUNTB.NE.0) WRITE(NUNTB,102) IUND,LISTE(1),LISTE(2)
      GOTO 64
   62 IF(NUNTB.NE.0) WRITE(NUNTB,103) IUND,LISTE(1),LISTE(2)
   64 IF(IW(INDA+51).EQ.100.AND.NUNTB.NE.0) WRITE(NUNTB,109) IUND
C
C     UPDATE FIRST DIRECTORY RECORD AND FREE DATA SET
C
   70 CALL DAY(DATE(1),DATE(2))
      CALL UCOPY(DATE,IW(INDA+25),4)
      IW(INDA+34)=IW(INDA+34)+JD
      CALL WRDA(1,IW(INDA+1),IW(INDA+2))
C
C     TWO ADDITIONAL WRITES TO FORCE BUFFER TO BE WRITTEN
C
      CALL WRDA(IW(INDA+6)-1,IW(INDA+1),IW(INDA+2))
      CALL WRDA(IW(INDA+6)  ,IW(INDA+1),IW(INDA+2))
C
C     UPDATE NRDIR BANK
C
      NAMUNT=NAMUN+(IUND/10)*256+MOD(IUND,10)
      IND=ILINK(NAMUNT,LISTE(1))
      IF(IND.EQ.0) GOTO 100
      NW=IW(IND+3)
      IF(NW.GT.3) GOTO 72
      IF(IOP.EQ.2) GOTO 100
      IW(IND+3)=4
      IW(IND+4)=LISTE(2)
      GOTO 100
   72 IF(LISTE(2).LT.IW(IND+4)) GOTO 74
      IF(IOP.EQ.2) GOTO 100
      IW(IND+1)=4
      GOTO 100
   74 DO 76 I=1,NW
      IF(IW(IND+I)-LISTE(2)) 76,78,79
   76 CONTINUE
      IF(IOP.EQ.2) GOTO 100
      IW(IND+2)=NW
      GOTO 100
   78 IF(IOP.EQ.3) GOTO 100
      IF(NW-I.GT.0) CALL UCOPY2(IW(IND+I+1),IW(IND+I),NW-I)
      IW(IND+3)=NW-1
      GOTO 100
   79 IF(IOP.EQ.2) GOTO 100
      IF(NW-I.GT.0) CALL UCOPY2(IW(IND+I),IW(IND+I+1),NW-I)
      IW(IND+I)=LISTE(2)
      IW(IND+2)=NW
      GOTO 100
C
C     PRINT OUT
C
   85 IPR=IPR+1
      IF(IPR.GT.100) GOTO 100
      IF(NUNTB.EQ.0) GOTO 100
      IF(JD.EQ.1) WRITE(NUNTB,107) IW(INDC-3),IW(INDC-2),IW(INDC)
      IF(JD.NE.1) WRITE(NUNTB,108) NAME,NR
      GOTO 100
C
C
   90 INDDIR=INDC
  100 RETURN
C
C     DATA SET SPACE LIMIT REACHED
C
  201 CALL BDMPA(201)
      GOTO 100
  102 FORMAT(' ---- UNIT',I3,' / INDDIR',5X,'BANK (',A4,',',I10,')',1X,
     1   'STORED')
  103 FORMAT(' ---- UNIT',I3,' / INDDIR',5X,'BANK (',A4,',',I10,')',1X,
     1   'REPLACED')
  104 FORMAT(' ---- UNIT',I3,' / INDDIR',5X,'BANK (',A4,',',I10,')',1X,
     1   'DELETED')
  107 FORMAT('0---- INDDIR     UNABLE TO STORE BANK (',A4,',',I10,
     1   ')',I10,' WORDS')
  108 FORMAT('0---- INDDIR     UNABLE TO DELETE BANK (',A4,',',I10,')')
  109 FORMAT(' ---- UNIT',I3,' / INDDIR PRINTOUT SUPPRESSED')
      END
