C   07/06/96 606071823  MEMBER NAME  BLOADA   (S4)          FORTG1
      SUBROUTINE BLOADA(IUNDA,IUNTP,IPASS)
C     BOS SUBPROGRAM  =4.3=
      COMMON/BCS/IW(1)
C   07/06/96 606071821  MEMBER NAME  CCS      (S4)          FORTG1
      COMMON/CCS/IUND,INDT,INDC,NPT,INDA,LISTE(5),IPAS
      REAL*8 DATE(2)
      INTEGER DIRA/'+DIR'/,IBOS/'BOSS'/
C     DISP = OLD
      CALL DAY(DATE(1),DATE(2))
      WRITE(6,102) IUNDA,IUNTP
      IUND=IUNDA
      INDT=0
      CALL BDLS('+DIR',IUNDA)
      CALL BGAR(IGA)
      CALL BCRE(INDA,'+DIR',IUNDA,52,*101,IER)
      CALL BSPC(IA,LB,IDUM1,IDUM2)
      IF(LB.LT.1610) GOTO 101
      CALL RDDA(1,IW(INDA+1),IW(INDA+2))
      IF(IW(INDA+2).NE.IW(INDA-3)) GOTO 101
      IF(IW(INDA+19).EQ.0) GOTO 5
      IF(IW(INDA+19).EQ.IPASS) GOTO 5
      IF(IPASS.EQ.IBOS) GOTO 5
      WRITE(6,103)
      STOP
    5 CALL BCRE(INDL,'+DIR',-1,2000,*101,IER)
      CALL BCRE(INDB,'+DIR',-2,3204,*101,IER)
      NREC=IW(INDA+6)
      NPRIME=NREC/20
      IF(NPRIME.LE.3) NPRIME=3
      NPRIME=NPRIME-2
   10 NPRIME=NPRIME+2
      A=NPRIME
      J=SQRT(A)
      DO 20 K=3,J,2
      NDIV=NPRIME/K
      IF(NDIV*K.EQ.NPRIME) GOTO 10
   20 CONTINUE
      IF(NPRIME.NE.IW(INDA+8)) GOTO 101
   22 IW(INDA+1)=4
      IW(INDA+2)=DIRA
      IW(INDA+3)=0
      IW(INDA+4)=0
      IW(INDA+5)=0
      IW(INDA+6)=NREC
      IW(INDA+7)=NPRIME+2
      IW(INDA+8)=NPRIME
      DO 24 K=1,NPRIME
      IW(INDA+3)=K+1
   24 CALL WRDA(K+1,IW(INDA+1),IW(INDA+2))
      IW(INDA+1)=0
      CALL WRDA(NPRIME+2,IW(INDA+1),IW(INDA+2))
      IW(INDA+1)=49
      IW(INDA+3)=0
      IW(INDA+5)=45
      CALL UCOPY(DATE,IW(INDA+21),4)
      CALL WRDA(1,IW(INDA+1),IW(INDA+2))
      NBK=0
      N=0
      NCT=0
      NERR=0
      IF(IUNTP.EQ.0) GOTO 40
   30 CALL RDSQ(IUNTP,NTOT,IW(INDB+1),*36)
      NCT=NCT+1
      IF(NTOT.LE.0.OR.NTOT.GT.3204) GOTO 32
      IF(NTOT-4.NE.IW(INDB+4)) GOTO 32
      GOTO 34
   32 NERR=NERR+1
      GOTO 30
   34 IF(NCT.EQ.0) GOTO 36
      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 DADA(3,*101)
      CALL UCOPY2(LISTE,IW(INDL+5*N+1),5)
      NBK=NBK+1
      N=N+1
      IF(N.LT.400) GOTO 30
   36 IF(N.EQ.0) GOTO 40
      CALL SORTIR(IW(INDL+1),N,5,5)
      CALL PODA(3,IW(INDL+1),N)
      IF(N.NE.400) GOTO 40
      N=0
      GOTO 30
   40 IW(INDA+33)=NBK
      IW(INDA+34)=NBK
      IW(INDA+35)=NBK
      CALL WRDA(1,IW(INDA+1),IW(INDA+2))
      NCT=NCT-NERR
      CALL BDLS('+DIR',-2)
      CALL BDLS('+DIR',-1)
      CALL BDLS('+DIR',IUNDA)
      CALL BPASDA(IUND,IPASS)
      CALL BLOCDA(IUND,INDBLA,'+DIR',0,*90)
      CALL BDLS('+DIR',0)
   90 CALL BDLS('+DIR',IUNDA)
      CALL BGAR(IGA)
      WRITE(6,104) NCT,NERR
C
  100 RETURN
  101 CALL BDMPA(14)
      GOTO 100
  102 FORMAT('0---- BLOADA    START FOR DA-DATASET',I3,5X,' LOAD ',
     1   'FROM SQ-DATASET',I3)
  103 FORMAT('0---- BLOADA    STOP, DA-DATASET PROTECTED, USE',
     1   ' CORRECT PASSWORD'/)
  104 FORMAT('0---- BLOADA    END,',I6,' RECORDS(BANKS)',
     1   ' COPIED,',I6,' ILLEGAL RECORDS'/)
      END
