pxolap.f

Go to the documentation of this file.

CDECK  ID>, PXOLAP.
******............................................................******
      SUBROUTINE pxolap(NJET,NTRAK,JETLIS,PJ,PP)
******............................................................******
*
*** Looks for particles assigned to more than 1 jet, and reassigns them
*** If more than a fraction OVLIM of a jet's energy is contained in
*** higher energy jets, that jet is neglected.
*** Particles assigned to the jet closest in angle (a la CDF, Snowmass).
*.
*. Modification Log.
*. 22-Apr-97: D. Chrisman - Dimension IJET with MXPROT instead of 30.
*.
      IMPLICIT NONE
      INTEGER mxtrak, mxprot
      parameter(mxtrak=200,mxprot=100)
      INTEGER njet, ntrak
      LOGICAL jetlis(mxprot,mxtrak)
      REAL pj(4,mxprot),pp(4,mxtrak)
      INTEGER i,j,n,mu
      LOGICAL ovelap
      REAL eover
      REAL ovlim
      INTEGER iterr, ijmin, ijet(mxprot), nj
      REAL vec1(3), vec2(3), cost, thet, thmin
      parameter(ovlim = 0.75)
*
      IF (njet.LE.1) RETURN
*** Look for jets with large overlaps with higher energy jets.
      DO 100 i = 2,njet
*** Find overlap energy between jets I and all higher energy jets.
       eover = 0.0
       DO 110 n = 1,ntrak
         ovelap = .false.
         DO 120 j= 1,i-1
           IF (jetlis(i,n).AND.jetlis(j,n)) THEN
            ovelap = .true.
           ENDIF
120      CONTINUE
         IF (ovelap) THEN
           eover = eover + pp(4,n)
         ENDIF
110     CONTINUE
*** Is the fraction of energy shared larger than OVLIM?
        IF (eover.GT.ovlim*pj(4,i)) THEN
*** De-assign all particles from Jet I
            DO 130 n = 1,ntrak
              jetlis(i,n) = .false.
130         CONTINUE
         ENDIF
100   CONTINUE
*** Now there are no big overlaps, assign every particle in
*** more than 1 jet to the closet jet.
*** Any particles now in more than 1 jet are assigned to the CLOSET
*** jet (in angle).
      DO 140 i=1,ntrak
         nj=0
         DO 150 j=1, njet
         IF(jetlis(j,i)) THEN
            nj=nj+1
            ijet(nj)=j
         ENDIF
150      CONTINUE
         IF (nj .GT. 1) THEN
*** Particle in > 1 jet - calc angles...
            vec1(1)=pp(1,i)
            vec1(2)=pp(2,i)
            vec1(3)=pp(3,i)
            thmin=0.
            DO 160 j=1,nj
               vec2(1)=pj(1,ijet(j))
               vec2(2)=pj(2,ijet(j))
               vec2(3)=pj(3,ijet(j))
               CALL pxang3(vec1,vec2,cost,thet,iterr)
               IF (j .EQ. 1) THEN
                  thmin=thet
                  ijmin=ijet(j)
               ELSEIF (thet .LT. thmin) THEN
                  thmin=thet
                  ijmin=ijet(j)
               ENDIF
160         CONTINUE
*** Assign track to IJMIN
            DO 170 j=1,njet
               jetlis(j,i) = .false.
170         CONTINUE
            jetlis(ijmin,i)=.true.
         ENDIF
140   CONTINUE
*** Recompute PJ
      DO 200 i = 1,njet
        DO 210 mu = 1,4
          pj(mu,i) = 0.0
210     CONTINUE
        DO 220 n = 1,ntrak
          IF( jetlis(i,n) ) THEN
            DO 230 mu = 1,4
             pj(mu,i) = pj(mu,i) + pp(mu,n)
230         CONTINUE
          ENDIF
220     CONTINUE
200   CONTINUE
      RETURN
      END