C   07/06/96 606071823  MEMBER NAME  BLOCDA   (S4)          FORTG1
      SUBROUTINE BLOCDA(IUNDA,IND,NAME,NR,*)
C     BOS SUBPROGRAM  =4.1=
      COMMON/BCS/IW(1)
#include "ccs.for"
      REAL*8 DATE(2)
      INTEGER IPR/0/
      IUND=IUNDA
      CALL BLOC(IND,NAME,NR,&10)
      GOTO 100
   10 LISTE(1)=NAME
      LISTE(2)=NR
      CALL PODA(1,LISTE,1)
      IF(INDT.EQ.0) GOTO 101
      CALL BCRE(IND,NAME,NR,0,&101,IER)
      INDC=IND
      CALL DADA(1,&12)
      IF(LISTE(4).NE.IW(IND)) GOTO 12
      GOTO 100
   12 CALL BDLS(NAME,NR)
      GOTO 101
C
      ENTRY BDLSDA(IUNDA,NAME,NR)
      ID=25
      JD=-1
      IUND=IUNDA
      LISTE(1)=NAME
      LISTE(2)=NR
      CALL PODA(1,LISTE,1)
      IF(IW(INDA+20).NE.0) GOTO 100
      IF(INDT.EQ.0) GOTO 100
      CALL CHDIR
      NPT=IW(INDT+3)
      CALL DADA(2,&50)
      CALL PODA(2,LISTE,1)
      IW(INDA+51)=IW(INDA+51)+1
      IF(IW(INDA+51).LE.100) WRITE(6,104) NAME,NR,IUNDA
      IF(IW(INDA+51).EQ.100) WRITE(6,109)
      GOTO 40
C
      ENTRY BCREDA(IUNDA,INDAR)
      ID=25
      JD=1
      IUND=IUNDA
      INDC=INDAR
      IF(IW(INDAR).LE.0) GOTO 60
      IF(IW(INDAR).GT.3200) GOTO 60
      LISTE(1)=IW(INDAR-3)
      LISTE(2)=IW(INDAR-2)
      CALL PODA(1,LISTE,1)
      IF(IW(INDA+20).NE.0) GOTO 100
      IF(IW(INDA+7)+2+IW(INDAR)/1610.GT.IW(INDA+6)) GOTO 60
      CALL CHDIR
      ICO=1
      IF(INDT.EQ.0) GOTO 20
      IW(INDA+34)=IW(INDA+34)-1
      ICO=2
      IF(IW(INDAR).EQ.LISTE(4)) GOTO 22
      CALL DADA(2,&50)
      CALL PODA(2,LISTE,1)
   20 CALL DADA(3,&50)
      CALL PODA(3,LISTE,1)
      GOTO 24
   22 CALL DADA(4,&50)
   24 IW(INDA+51)=IW(INDA+51)+1
      IF(IW(INDA+51).GT.100) GOTO 40
      GOTO (26,28),ICO
   26 WRITE(6,102) LISTE(1),LISTE(2),IUNDA
      GOTO 30
   28 WRITE(6,103) LISTE(1),LISTE(2),IUNDA
   30 IF(IW(INDA+51).EQ.100) WRITE(6,109)
C
   40 CALL DAY(DATE(1),DATE(2))
      CALL UCOPY(DATE,IW(INDA+ID),4)
      IW(INDA+34)=IW(INDA+34)+JD
      CALL WRDA(1,IW(INDA+1),IW(INDA+2))
      GOTO 100
   50 CALL WRDA(1,IW(INDA+1),IW(INDA+2))
   60 IPR=IPR+1
      IF(IPR.GT.100) GOTO 100
      IF(JD.EQ.1) WRITE(6,107) IW(INDAR-3),IW(INDAR-2),IW(INDAR)
      IF(JD.NE.1) WRITE(6,108) NAME,NR
      GOTO 100
C
      ENTRY BCHKDA(IUNDA,NAME,NR,NWD)
      IUND=IUNDA
      LISTE(1)=NAME
      LISTE(2)=NR
      CALL PODA(1,LISTE,1)
      NWD=0
      IF(INDT.EQ.0) GOTO 100
      NWD=LISTE(4)
C
  100 RETURN
  101 RETURN 1
  102 FORMAT(' ---- BCREDA',5X,'BANK (',A4,',',I10,')   ADDED TO   ',
     1   'DATA SET',I3)
  103 FORMAT(' ---- BCREDA',5X,'BANK (',A4,',',I10,') REPLACED IN  ',
     1   'DATA SET',I3)
  104 FORMAT(' ---- BDLSDA',5X,'BANK (',A4,',',I10,') DELETED FROM ',
     1   'DATA SET',I3)
  107 FORMAT('0---- BCREDA     UNABLE TO STORE BANK (',A4,',',I10,
     1   ')',I10,' WORDS')
  108 FORMAT('0---- BDLSDA     UNABLE TO DELETE BANK (',A4,',',I10,')')
  109 FORMAT(' ---- BCREDA/BDLSDA - PRINTOUT SUPPRESSED')
      END
