symrgj.f

Go to the documentation of this file.

CDECK  ID>, SYMRGJ.
**************************************************************************
      SUBROUTINE symrgj
     +  (nfin,iexam4,n0jet,npart,ijout,qjet,ijfin,qjfin4,ierr)
*  Jet Merge Routine
*  Authour : Satoru Yamashita
*  Creat   : 1-Oct-97
*  Mod     : 1-Feb-98 S.Yamashita buffer size increased
*
*    Inputs:
*      NFIN   ;  requested Number of Jets
*      IEXAM4 ;  Jet merge method  1-8
*      N0JET  ;  Number of original Jets (>=NFIN)
*      NPART  ;  Number of particles
*      IJOUT  ;  Original Jet assignment for "particle"s
*      QJET   ;  Original Jet 6-momenta
*    Outputs:
*      IJFIN  ;  New Jet assignment of "particle"s for the Merged Jet
*      QJFIN4 ;  New merged Jet 6-momenta
*      IERR   ;  0=O.K   Others=error
      implicit none
      INTEGER mxjet
      parameter(mxjet = 30)
      INTEGER i,j,n,imins,jmins
      REAL    examin
      INTEGER nfin,iexam4
      INTEGER n0jet,npart
      INTEGER ijout(*)
      REAL    qjet(6,*)
      INTEGER ijfin(*)
      REAL    qjfin4(6,*),qtemp(6,mxjet)
      INTEGER ierr

      REAL    durham(mxjet,mxjet)
      REAL    e0jade(mxjet,mxjet)
      REAL    ejade(mxjet,mxjet)
      REAL    angle(mxjet,mxjet)
      REAL    ecos(mxjet,mxjet)
      REAL    rmult(mxjet,mxjet)
      REAL    pl(6,mxjet)
      INTEGER mxexam
      parameter(mxexam = 8)
      REAL    exam(mxexam,1000)
      INTEGER nnjet,idjet(mxjet),idtemp(mxjet)

*            EXAM(1,N) = PL(4,I)*PL(4,J)
*            EXAM(2,N) = RMULT(I,J)
*            EXAM(3,N) = DURHAM(I,J)
*            EXAM(4,N) = E0JADE(I,J)
*            EXAM(5,N) = EJADE(I,J)
*            EXAM(6,N) = ANGLE(I,J)
*            EXAM(7,N) = ECOS(I,J)
*            EXAM(8,N) = PL(6,I)*PL(6,J)
*
CC OLD  1996  S.Y
CC            EXAM(1) = THETA
CC            EXAM(2) = - SQRT(EMIN2) * COSTH
CC            EXAM(3) = DURHAM
CC            EXAM(4) = E0JADE
CC            EXAM(5) = EJADE
*
*
** INITIALYSE
      DO i=1,nfin
         DO j=1,6
            qjfin4(j,i) = 0.0
         ENDDO
      ENDDO
      DO i=1,npart
         ijfin(i) = 0
      ENDDO
      ierr = 0

      IF(n0jet.LT.nfin) THEN
         ierr = 1
         RETURN
      ELSE IF(n0jet.EQ.nfin) THEN  ! Just Copy
         DO i=1,nfin
            DO j=1,6
               qjfin4(j,i) = qjet(j,i)
            ENDDO
         ENDDO
         DO i=1,npart
            ijfin(i) = ijout(i)
         ENDDO
         RETURN
      ENDIF

      IF(iexam4.LT.1.OR.iexam4.LT.mxexam) THEN
         ierr = -80
         RETURN
      ENDIF

      DO i=1,n0jet
         DO j=1,6
            pl(j,i) = qjet(j,i)
         ENDDO
         idjet(i) = i
      ENDDO

      nnjet = n0jet
 100  CONTINUE
      IF(nnjet.LE.nfin) THEN
         goto 777
      ENDIF

      n=0
      DO i=1,nnjet-1
         DO j=i+1,nnjet
            n=n+1

            e0jade(i,j) =
     +           2.*pl(4,i)*pl(4,j)*max(0.,(1.-
     +           (pl(1,i)*pl(1,j)+pl(2,i)*pl(2,j)+pl(3,i)*pl(3,j))/
     +           (pl(6,i)*pl(6,j))))
            durham(i,j) =
     +           2.*min(pl(4,i)*pl(4,i),pl(4,j)*pl(4,j))*max(0.,(1.-
     +           (pl(1,i)*pl(1,j)+pl(2,i)*pl(2,j)+pl(3,i)*pl(3,j))/
     +           (pl(6,i)*pl(6,j))))
            ejade(i,j) =
     +           max(0.,(pl(4,i)+pl(4,j))**2-(pl(1,i)+pl(1,j))**2-
     +           (pl(2,i)+pl(2,j))**2-(pl(3,i)+pl(3,j))**2)
            angle(i,j) =
     +           (pl(1,i)*pl(1,j)+pl(2,i)*pl(2,j)+pl(3,i)*pl(3,j))/
     +           (pl(6,i)*pl(6,j))
            angle(i,j) = min(angle(i,j), 1.)
            angle(i,j) = max(angle(i,j),-1.)
            angle(i,j) = acos(angle(i,j))
            ecos(i,j)  = -min(pl(4,i),pl(4,j)) *
     +           (pl(1,i)*pl(1,j)+pl(2,i)*pl(2,j)+pl(3,i)*pl(3,j))/
     +           (pl(6,i)*pl(6,j))
            rmult(i,j) = pl(4,i)*pl(4,j)-pl(1,i)*pl(1,j)
     +           -pl(2,i)*pl(2,j)-pl(3,i)*pl(3,j)

            exam(1,n) = pl(4,i)*pl(4,j)
            exam(2,n) = rmult(i,j)
            exam(3,n) = durham(i,j)
            exam(4,n) = e0jade(i,j)
            exam(5,n) = ejade(i,j)
            exam(6,n) = angle(i,j)
            exam(7,n) = ecos(i,j)
            exam(8,n) = pl(6,i)*pl(6,j)
         ENDDO
      ENDDO

      n=0
      imins=0
      jmins=0
      examin = 1.e+10
      DO i=1,nnjet-1
         DO j=i+1,nnjet
            n=n+1
            IF(exam(iexam4,n).LT.examin) THEN
               imins=i
               jmins=j
               examin=exam(iexam4,n)
            ENDIF
         ENDDO
      ENDDO

*     MERGE JETS
      DO i=1,nnjet
         DO j=1,6
            qtemp(j,i) = pl(j,i)
         ENDDO
      ENDDO
      DO i=1,n0jet
         idtemp(i) = idjet(i)
      ENDDO
      DO i=1,n0jet
         idjet(i) = 0
      ENDDO

      n = 0
      DO i=1,nnjet
         IF(i.NE.imins.AND.i.NE.jmins) THEN
            n = n + 1
            DO j=1,6
               pl(j,n) = qtemp(j,i)
            ENDDO
            DO j=1,n0jet
               IF(idtemp(j).EQ.i) THEN
                  idjet(j)   = n
               ENDIF
            ENDDO
         ENDIF
      ENDDO
      nnjet = nnjet - 1
      DO j=1,6
         pl(j,nnjet) = qtemp(j,imins)+qtemp(j,jmins)
      ENDDO
      DO j=1,n0jet
         IF(idtemp(j).EQ.imins.OR.idtemp(j).EQ.jmins) THEN
            idjet(j)   = nnjet
         ENDIF
      ENDDO
      goto 100

 777  CONTINUE
      DO i=1,nfin
         DO j=1,6
            qjfin4(j,i) = pl(j,i)
         ENDDO
      ENDDO
      DO i=1,npart
         ijfin(i) = idjet(ijout(i))
      ENDDO

      END