C   07/08/79 311041222  MEMBER NAME  MNCOPY   (S)           FORTRAN
      SUBROUTINE MNCOPY
      IMPLICIT INTEGER *2(H)
      COMMON/BCS/IDATA(40000)
      COMMON/POINT/IPHEAD,IPLTCH,IPT1,IPTOF,IPCLST,IPR,IPPATR,IPNT(12),
     1             IPBP
      COMMON/TRKINF/NTRK,DX1(10),DY1(10),DZ1(10),DXL(10),DYL(10),
     1              DZL(10),NXY(10),NRZ(10),CHIXY(10),DRZ(10),CHIRZ(10),
     2              X1(10),Y1(10),Z1(10),XL(10),YL(10),ZL(10),ZVER(10),
     3              NGOOD,IGOOD(10),PMOM(10),FI1(10),FIL(10)
      DIMENSION RDATA(6000),HDATA(12000),PH(10),SIG(3)
      EQUIVALENCE(IDATA(1),RDATA(1)),(HDATA(1),IDATA(1))
      COMMON/PU/ NTOF,NBEAM,IHIT(200),DPHI
      COMMON/EVRUN/NRUN,IEV,ITYP,NEV,IMISS
      COMMON/INOUT/WRITFL,EVWRIT
      LOGICAL WRITFL,EVWRIT
C
      DATA NUN/2/,IONE/1/,ITWO/2/,ITHR/3/,IFOU/4/,IFIV/5/
      DATA ISIX,ISEV,IEIG/6,7,8/
C
      IWRITE =0
      IFILE = 0
      WRITFL = .TRUE.
      CALL BINT(40000,4000,500,0)
      IF(WRITFL) CALL BWRO(3,1558,2)

      NEV = 0
      IRUN = 0
      NEVRUN = 0
      NEVA = 0
      NEVB = 500000
      DO   1   N=1,500000
 77    CONTINUE
      NEV = NEV + 1
      NEVRUN = NEVRUN + 1
      IF(IUHR(5).NE.1)  GOTO  7002
      CALL BSLT
      CALL BDLG
      CALL BREAD(NUN,&1000,&7000)
      IF(NEV.LE.NEVA)  GOTO  2
      IF(NEV.GT.NEVB)  GOTO  7000
      IPHEAD = IDATA(IBLN('HEAD'))
      IF(IPHEAD.LE.0)  GOTO  2000
      NRUN = HDATA(IPHEAD*2+10)
C     IF(NRUN.LT.10265)  GOTO  2
      IF(NRUN.GT.14605)  GOTO  7000
      IEV=HDATA(2*IPHEAD+11)
      IF(NRUN.EQ.IRUN)  GOTO  74
      PRINT 704,NRUN,NEV,NEVRUN,IEV,IWRITE
  704 FORMAT(' NEW RUN AT EVENT ',5I10)
      NEVRUN = 0
   74 IRUN = NRUN
  23  IWRITE = IWRITE+ 1
C     IF(IWRITE.GT.200)  GOTO  7000
      CALL BSLW
      CALL BWRITE(3)
    2 GOTO  1
 3000 PRINT 3010
 3010 FORMAT(' ERROR RETURN FROM TOFINT')
      GOTO  2
 3001 PRINT 3011
 3011 FORMAT(' ERROR RETURN FROM TOFMAS')
      GOTO  2
2000   WRITE(6,2001) IONE,NEV
       GOTO 77
2002   WRITE(6,2001) ITWO,NEV
       GOTO 77
2003   WRITE(6,2001) ITHR,NEV
       GOTO 77
2004   WRITE(6,2001) IFOU,NEV
       GOTO 77
2005   WRITE(6,2001) IFIV,NEV
      GOTO  77
 400   WRITE(6,2001) ISIX,NEV
      GOTO  77
 401   WRITE(6,2001) ISEV,NEV
      GOTO  77
 402   WRITE(6,2001) IEIG,NEV
      GOTO  77
      IMISS = 0
1000   WRITE(6,1001)I
1001   FORMAT(' ERROR IN BREAD  I=',I3)
2001   FORMAT(' ERROR IN BLOC   I=',2I5)
1      CONTINUE
 7002 PRINT 777
      PRINT 777
      PRINT 777
  777 FORMAT('  ********   TIMELIMIT   ********')
7000  WRITE(6,7001)NRUN,IEV,ITYP,NEV
      CALL BMLT(0,DUMMY)
      CALL BWRITE(3)
7001  FORMAT(' LAST RUN',I8,' IEV=',I5,' ITYP=',I3,' NEV=',I5)
      PRINT600,IWRITE
  600 FORMAT(' EVENTS WRITTEN ',I10)
      CALL BSTA
      RETURN
      END
