+PATCH,$CORR.
+DECK,CORR1.                     Updates version:  2.04/00  to   2.04/01
+REP,*TITLE*,TITLE,1.
BCTRAK    2.04/01  14/02/96  18.15.04
+REP,$VERSION,V2_04,1-2.
*CMZU:  2.04/01 14/02/96  18.15.04  by  Unknown
*CMZU:  2.04/00 24/08/95  16.09.24  by  Christian Voelcker
*-- Author :    Christian Voelcker   24/08/95
*
*::>          VERSION  2.04/01   14/02/96 18.15.04
*		BK
*		Bugfix for jun 94 data that were contaminated with
*               lightpulser events.
*		Events with big forward,backward assymmetry in
*		(number of xtals) are very likely to contain
*		a lighpulser flash, or an afterglow of a flash.
*
* 	routine bcevck added.
*		works only for run numbers: 21266-24000.
*		generates messages: "<bcevck.."
*		if events are rejectes in the logfile
* 	routine bctrak changed, call for bcevck before CALL USEVNT(13)
*
+ADD,BCPHYS,BCTRAK,0.
*CMZU:  2.04/01 14/02/96  18.06.03  by  Unknown
+ADD,BCPHYS,BCTRAK,26.
***      Modified: 14-FEB-1995 BK: call to BCEVCK added to solve       *
***		lightpulser problems in jun94                          *
+REP,BCPHYS,BCTRAK,49.
      INTEGER I,DUMMY1,DUMMY2
+REP,BCPHYS,BCTRAK,121.
**          If no energy calculation:
+REP,BCPHYS,BCTRAK,144.
*     end of energy calculation

*     reject events with lightpulser flashes in June 94 run.
      CALL BCEVCK(1,DUMMY1,DUMMY2)
+ADD,BCPHYS,BCEVCK,*.
&DECK,bcevck.
*CMZU:  2.04/01 14/02/96  16.52.06  by  Bernd Kaemmle
*-- Author :
*********************************************************************
*                                                                   *
*     SUBROUTINE BCEVCK(ICODE,IFLAG,IERR)                           *
*                           check event for run-dependent problems. *
*                                                                   *
*                                                                   *
*     Author:               Christian Voelcker                      *
*                           Bernd Kaemmle                           *
*                                                                   *
*     Creation Date:        12/02/96                                *
*                                                                   *
*                                                                   *
*     Input argument:       ICODE   Type of event check             *
*                           1    check, if lightpulser has flashed  *
*                                using crystal forward/backward     *
*                                assymetry                          *
*                                                                   *
*     Output arguments:     IFLAG   1 = event accepted              *
*                                   0 = event rejected              *
*                                                                   *
*                           IERR    error code                      *
*                                   0 = OK                          *
*                                   -1 = cannot access LTBEL bank   *
*                                                                   *
*     Called By:                                                    *
*                                                                   *
*     Modifications:                                                *
*                                                                   *
*                                                                   *
*********************************************************************
 
 
      SUBROUTINE BCEVCK(ICODE,IFLAG,IERR)
&SEQ,IMPNONE.
      INTEGER ICODE,IFLAG,IERR
&SEQ,CBLINK.
&SEQ,CBCNTL.
 
      LOGICAL QREJECT
      INTEGER FXTAL,BXTAL,ICOMP,I
      INTEGER IERBKN,IERBKL,IERASN,IERASL,IERASR
      SAVE    IERBKN,IERBKL,IERASN,IERASL,IERASR
      REAL    FBXAS
 
      DATA    IERBKN,IERBKL,IERASN,IERASL,IERASR /0,0,0,0,0/
 
      IFLAG=1
      IERR=0
 
      IF(ICODE.EQ.1) THEN
* check events for contamination with lichtpuser flashes
        IF(IEHDCB(4).GT.21266.AND.IEHDCB(4).LT.24000) THEN
* this is was only a problem in june94 run!
          QREJECT = .FALSE.
 
 
**** check assymetry using information in tbel bank *******************
*
*	FXTAL = number of  forward xtals fired
*	BXTAL = number of backward xtals fired
 
          FXTAL = 0
          BXTAL = 0
*
          IF (LTBEL.GT.0) THEN
             DO I= 1, IQ(LTBEL+1)
                ICOMP =  IQ(LTBEL + 2*I )
*  upstream or downstream ?
                IF (ICOMP.GT.780) THEN
                   BXTAL = BXTAL + 1
                ELSE
                   FXTAL = FXTAL + 1
                ENDIF
             ENDDO
          ELSE
             IERR=-1
              CALL ERRLOG(IERBKL,
     &          ' <BCEVCK> Cannot find LTBEL bank')
          ENDIF
* forward - backward  assymetry for lightpulser rejection.
          IF ((BXTAL+FXTAL).EQ.0)  THEN
             FBXAS = 0.
          ELSE
             FBXAS = FLOAT(FXTAL-BXTAL)/FLOAT(FXTAL+BXTAL)
          ENDIF
 
          FBXAS = ABS(FBXAS)
* test the forward-backward assymetry to reject lightpluser flashes,
* even if the ppbar annihilation comes shortly after the flash, and
* only a few crystals
* still show a signal (afterglow). This cut rejects about 1E-5
* normal events (at rest, in LH).
* symmetric events get a limit at 390 xtals,
* completely asymetric ones at 390-350=40 xtals.
* Be careful when looking for missing particles!!
          IF(IQ(LTBEL+1).GT. 390.-350.*FBXAS ) THEN
              IFLAG=0
              QREJECT = .TRUE.
              CALL ERRLOG(IERASL,
     &  ' <BCEVCK> Light pulser flashed ?!!! (assymetry in TBEL)')
          ENDIF
 
**** check assymetry using information in tben bank *******************
 
          FXTAL = 0
          BXTAL = 0
*
          IF (LTBEN.GT.0) THEN
             DO I= 1, IQ(LTBEN+1)
                ICOMP =  IQ(LTBEN + 2*I )
*  upstream or downstream ?
                IF (ICOMP.GT.780) THEN
                   BXTAL = BXTAL + 1
                ELSE
                   FXTAL = FXTAL + 1
                ENDIF
             ENDDO
          ELSE
             IERR=-1
              CALL ERRLOG(IERBKN,
     &          ' <BCEVCK> Cannot find LTBEN bank')
          ENDIF
* forward - backward  assymetry for lightpulser rejection.
          IF ((BXTAL+FXTAL).EQ.0)  THEN
             FBXAS = 0.
          ELSE
             FBXAS = FLOAT(FXTAL-BXTAL)/FLOAT(FXTAL+BXTAL)
          ENDIF
 
          FBXAS = ABS(FBXAS)
* test the forward-backward assymetry to reject lightpluser flashes,
* even if the ppbar annihilation comes shortly after the flash, and
* only a few crystals
* still show a signal (afterglow). This cut rejects about 1E-5
* normal events (at rest, in LH).
* symmetric events get a limit at 390 xtals,
* completely asymetric ones at 350-300=50 xtals.
* Be careful when looking for missing particles!!
          IF(IQ(LTBEL+1).GT. 350.-300.*FBXAS ) THEN
              IFLAG=0
              QREJECT = .TRUE.
              CALL ERRLOG(IERASN,
     &  ' <BCEVCK> Light pulser flashed ?!!! (assymetry in TBEN)')
          ENDIF
 
          IF(QREJECT) THEN
             ACCECB=.FALSE.
             CALL ERRLOG(IERASR,
     &  ' <BCEVCK(1)> event rejected!! (assymetry in TBEN or TBEL)')
          ENDIF
 
        ENDIF       ! end run number check
      ENDIF         ! end if icode=1
 
 
      RETURN
      END