+PATCH,$CORR.
+DECK,CORR1.                     Updates version:  2.04/00  to   2.04/03
+REP,*TITLE*,TITLE,1.
BCTRAK    2.04/03  26/11/96  18.39.39
+REP,$VERSION,V2_04,1-2.
*CMZU:  2.04/03 26/11/96  18.39.39  by  Rafik Ouared
*CMZ :  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/03   26/11/96 18.39.39
*               clean resetting of NFLAG and ENRDIV arrays
*               to avoid dramatic drop of efficiency with time down
*               to 50% for 10 gammas in_flight data (M.Kunze)
*
*
*::>          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,BCPEDS,0.
*CMZU:  2.04/03 26/11/96  18.39.32  by  Rafik Ouared
*        resetting NFLAG,ENRDIV properly
+ADD,BCPHYS,BCPEDS,63.
***      Updated: 26-NOV-1996 R.Ouared                                 *
***               clean resetting of NFLAG and ENRDIV arrays           *
***               to avoid dramatic drop of efficiency with time down  *
***               to 50% for 10 gammas in_flight data (M.Kunze)        *
+REP,BCPHYS,BCPEDS,177-191.
*       Flag all xtals in cluster, calculate energy of cluster
         ECLST = 0.
         DO 100 I=1,N
            FLAGQ( IQ(JTBCL+I) ) = .TRUE.
            ECLST = ECLST + ENERQ( IQ(JTBCL+I) )
  100    CONTINUE
*           initialize variables for N-PED cluster handling
         IF (PDRGBC) THEN
            CALL VZERO(NFLAG,26*60)
            CALL VZERO(ENRDIV,26*60)
         END IF
*
+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
 
+ADD,$KUMACS,INSTALL,0.
*CMZU:  2.04/02 29/05/96  18.38.03  by  F.-H.Heinsius
+DEL,$KUMACS,INSTALL,35.
+REP,$KUMACS,INSTALL,86-88.
     Endcase
     (IBMRT) Select $OS
     (SGI)   Select $OS
     (SOLARIS) Select SUN
+REP,$KUMACS,INSTALL,110-112.
      XACL = -XACLP
   else
      XACL = -XADCLP
+REP,$KUMACS,INSTALL,145.
         (HPUX,SGI,SUN,DECS,IBMRT,SOLARIS) DEBUGOPT=' -g -C'
+REP,$KUMACS,INSTALL,153.
      Case $OS In
         (VMS)   DEBUGOPT='    '
         (UNIX)  DEBUGOPT=' -O '
      Endcase
+REP,$KUMACS,INSTALL,183-196.
     Set '`which g77` -c'//[DEBUGOPT]//'  -w $compfile' -C f77
     Set '`which gcc` -c'//[DEBUGOPT]//'  -w $compfile' -C C
   else
     Case $MACHINE In
     (HPUX) Set 'f77 -c'//[DEBUGOPT]//' +ppu $compfile' -C f77
          Set 'cc -c -O -w '//[DEBUGOPT]//'        $compfile' -C C
     (SUN) Set 'f77 -c'//[DEBUGOPT]//' -fnonstd -Nl100 -w $compfile' -C f77
         Set 'gcc -c'//[DEBUGOPT]//'  -w $compfile' -C C
     (SOLARIS) Set 'f77 -c'//[DEBUGOPT]//' -w $compfile' -C f77
         Set 'gcc -c'//[DEBUGOPT]//'  -w $compfile' -C C
     (IBMRT) Set 'xlf -c'//[DEBUGOPT]//' -qextname $compfile' -C f77
            Set 'cc -c -w '//[DEBUGOPT]//'        $compfile' -C C
     (SGI)   Set 'f77 -c'//[DEBUGOPT]//' $compfile G 3' -C f77
            Set 'cc -c -w '//[DEBUGOPT]//'        $compfile' -C C
     (DECS)  Set 'f77 -c -w -Nl99 '//[DEBUGOPT]//' $compfile' -C f77
            Set 'cc -c -w '//[DEBUGOPT]//'        $compfile' -C C
+REP,$KUMACS,INSTALL,203-204.
      (UNIX) Set 'f77 -c  -w -Nl99 '//[DEBUGOPT]//' $compfile' -C f77
            Set 'cc -c  -w '//[DEBUGOPT]//' $compfile' -C C