pxsear.f

Go to the documentation of this file.

CDECK  ID>, PXSEAR.
******............................................................******
      SUBROUTINE pxsear(COSR,NTRAK,PU,PP,VSEED,NJET,
     +                jetlis,pj,unstbl,ierr)
******............................................................******
*
      IMPLICIT NONE
      INTEGER mxtrak, mxprot
      parameter(mxtrak=200,mxprot=100)
      INTEGER ntrak, ierr
      REAL cosr,pu(3,mxtrak),pp(4,mxtrak),vseed(3)
      LOGICAL unstbl
      LOGICAL jetlis(mxprot,mxtrak)
      INTEGER njet
      REAL  pj(4,mxprot)
*** Using VSEED as a trial axis , look for a stable jet.
*** Check stable jets against those already found and add to PJ.
*** Will try up to MXITER iterations to get a stable set of particles
*** in the cone.
      INTEGER mu,n,iter
      LOGICAL pxsame,pxnew,ok
      LOGICAL newlis(mxtrak),oldlis(mxtrak)
      REAL oaxis(3),naxis(3),pnew(4)
      INTEGER mxiter
      parameter(mxiter = 30)
*
      DO 100 mu=1,3
        oaxis(mu) = vseed(mu)
100   CONTINUE
      DO 110 n = 1,ntrak
        oldlis(n) = .false.
110   CONTINUE
      DO 120 iter = 1,mxiter
        CALL pxtry(cosr,ntrak,pu,pp,oaxis,naxis,pnew,newlis,ok)
*** Return immediately if there were no particles in the cone.
       IF (.NOT.ok) THEN
         RETURN
       ENDIF
       IF(pxsame(newlis,oldlis,ntrak)) THEN
*** We have a stable jet.
             IF (pxnew(newlis,jetlis,ntrak,njet)) THEN
*** And the jet is a new one. So add it to our arrays.
*** Check arrays are big anough...
             IF (njet .EQ. mxprot) THEN
             WRITE (6,*) ' PXCONE:  Found more than MXPROT proto-jets'
                ierr = -1
                RETURN
             ENDIF
               njet = njet + 1
               DO 130 n = 1,ntrak
                 jetlis(njet,n) = newlis(n)
130            CONTINUE
               DO 140 mu=1,4
                 pj(mu,njet)=pnew(mu)
140          CONTINUE
             ENDIF
             RETURN
       ENDIF
*** The jet was not stable, so we iterate again
       DO 150 n=1,ntrak
         oldlis(n)=newlis(n)
150    CONTINUE
       DO 160 mu=1,3
         oaxis(mu)=naxis(mu)
160    CONTINUE
120   CONTINUE
      unstbl = .true.
      RETURN
      END