C   07/06/96 606071841  MEMBER NAME  DAFR     (S4)          FORTRAN
      SUBROUTINE DAFR(IGOTO)
C
C     VERSION JULY 82
C
      COMMON/ACS/DUMMI(90),NUNTB
C
C     ACCESS TO DATA RECORD OF DIRECT ACCESS DATA SET
C
C     IGOTO = 1   GET BANK FROM DIRECT ACC. DS
C             2   DELETE BANK FROM DIRECT ACC. DS
C             3   ADD BANK TO DIRECT ACC. DS
C             4   ADD BANK IN PREVIOUS PLACE (SAME LENGTH AS BEFORE)
C
C
C     INTERMEDIATE VARIABLES INDB = INDEX TO DATA IN BANK
C                            NWLB = NR OF DATA WORDS LEFT
C                            NPTR = NR OF DATA RECORD
      COMMON/BCS/IW(1)
      COMMON/CCS/IUND,INDT,INDC,NPTR,INDA,LISTE(5),IPAS,NDAREC
      INDB=INDC
      IF(IGOTO.EQ.3) GOTO 50
C
C     ADD, DELETE OR REPLACE
C
      NPTR=LISTE(3)
      NWLB=LISTE(4)
      IA=IBANK(0,0,0)
      IF(IW(IA).LT.NDAREC) GOTO 101
C
C     READ DATA RECORD AND SEARCH FOR NAME,NR
C
   10 CALL RDDA(NPTR,NDAREC,IW(IA))
      INDH=IA+4
      INDL=IA+IW(IA)
      GOTO 14
   12 IF(NPTR.NE.LISTE(3).AND.IGOTO.EQ.2)       GOTO 100
      IF(NPTR.NE.LISTE(3))       GOTO 102
      INDH=INDH+IW(INDH)+4
   14 IF(INDH.GT.INDL.AND.IGOTO.EQ.2)           GOTO 100
      IF(INDH.GT.INDL)           GOTO 102
      IF(IW(INDH-3).NE.LISTE(1)) GOTO 12
      IF(IW(INDH-2).NE.LISTE(2)) GOTO 12
      IF(IGOTO-2) 20,30,40
C
C     COPY BANK FROM DATA RECORD OF DIRECT ACCESS DATA SET
C
   20 CALL UCOPY(IW(INDH+1),IW(INDB+1),IW(INDH))
      INDB=INDB+IW(INDH)
      NWLB=NWLB-IW(INDH)
      IF(NWLB.LE.0) GOTO 100
      NPTR=NPTR+1
      GOTO 10
C
C     DELETE BANK FROM DATA RECORD OF DIRECT ACCESS DATA SET
C
   30 INDS=INDH+IW(INDH)
      NWDS=INDL-INDS
      NWLB=NWLB-IW(INDH)
      IW(IA)=IW(IA)-4-IW(INDH)
      IF(NWDS.GT.0) CALL UCOPY2(IW(INDS+1),IW(INDH-3),NWDS)
C
C     WRITE CHANGED DATA RECORD BACK TO DS
C
   35 CALL WRDA(NPTR,IW(IA),IW(IA+1))
      IF(NWLB.LE.0) GOTO 100
      NPTR=NPTR+1
      GOTO 10
C
C     ADD BANK IN DATA RECORD (SAME PLACE AS BEFORE)
C
   40 CALL UCOPY(IW(INDB+1),IW(INDH+1),IW(INDH))
      INDB=INDB+IW(INDH)
      NWLB=NWLB-IW(INDH)
      GOTO 35
C
C     ADD BANK TO DATA RECORD IN DIRECT ACCESS DATA SET
C
   50 NWLB=IW(INDB)
      NPTR=IW(INDA+7)
      LISTE(3)=0
      LISTE(4)=NWLB
      IA=IBANK(0,0,0)
      IF(IW(IA).LT.NDAREC) GOTO 101
      CALL RDDA(NPTR,NDAREC,IW(IA))
C
C
C
   55 NTOT=IW(IA)
      IF(NTOT.GT.NDAREC-5) GOTO 60
      CALL UCOPY(IW(INDC-3),IW(IA+NTOT+1),4)
      NTOT=NTOT+4
      IW(IA)=NTOT
      NWCP=MIN0(NDAREC-1-NTOT,NWLB)
      IW(IA+NTOT)=NWCP
      CALL UCOPY(IW(INDB+1),IW(IA+NTOT+1),NWCP)
      IF(LISTE(3).EQ.0) LISTE(3)=NPTR
      NTOT=NTOT+NWCP
      IW(IA)=NTOT
      INDB=INDB+NWCP
      NWLB=NWLB-NWCP
      CALL WRDA(NPTR,IW(IA),IW(IA+1))
      IF(NWLB.EQ.0) GOTO 100
C
C     INCREASE RECORD NUMBER AND PREPARE NEW RECORD
C
   60 IW(INDA+7)=IW(INDA+7)+1
      IW(IA)=0
      NPTR=IW(INDA+7)
      GOTO 55
C
C
C
  100 RETURN
C
C     INSUFFICIENT SPACE FOR DIRAC OPERATION
C
  101 CALL BDMPA(101)
C
C     DIRECTORY/DATA RECORD ERROR
C
  102 IF(IGOTO.EQ.2) GOTO 100
      IF(IGOTO.NE.1) GOTO 1002
C
C     DELETE BANK
C
      INDC=IBANK(LISTE(1),LISTE(2),'DL')
      GOTO 100
 1002 CALL BDMPA(102)
      GOTO 100
      END
