syjetf0.f

Go to the documentation of this file.

CDECK  ID>, SYJETF0.
      SUBROUTINE syjetf0(IMODE,YCUT,EPS0,R0,NJETRQ,NPAR0,PPAR0,IUSE,
     +                   njet,ipass0,pjet6,y34,y45,ierr)
*  Traditional Jet Finders
*  Authour : Satoru Yamashita
*  Creat   : 1-Oct-97
*
*     IMODE : 1,2,3,4,5,6,7,8,9,10,11,12   : fixed YCUT, or EPS-R cut
*     IMODE : 101,102,103,104,105,,,,112   : fixed NJET
*
      implicit none
      INTEGER imode
      REAL    ycut,rin,epsin
      INTEGER njetrq,npar0,ipass0(*),iuse(*),jmode
      INTEGER npar,ierr,i,njet,ipass(300),k,ijmul(10),j
      REAL ppar(5,300),ppar0(5,*)
      REAL pjj(10,10),y34,y45,pjet(5,10),pjet6(6,*)
      REAL p4(4,10)
      REAL eps0,r0
      REAL rout,epsout,ydum
      INTEGER njetout,njdum

*====== initialyzation
      njet = 0
      DO i=1,npar0
         ipass0(i)=-1
      ENDDO
      CALL vzero(pjet,5*10)
      CALL vzero(ipass0,npar0)
      y34 = 0.
      y45 = 0.
      ierr = 0
      npar = 0
      DO i=1,npar0
         IF(iuse(i).GT.0) THEN
            npar = npar + 1
            DO k=1,5
               ppar(k,npar) = ppar0(k,i)
            ENDDO
         ENDIF
      ENDDO
      IF(npar.LE.2) THEN
         WRITE(*,'(A,I3,I10)')'NPAR LT 3',npar,npar0
*         CALL REPORT('JETFIN',1,'E')
         ierr = -10
         goto 999
      ENDIF
      IF(imode.GT.100.AND.npar.LT.njetrq) THEN
         WRITE(*,'(A,I3,I10)')'NPAR LT NJRQ',npar,njetrq
*         CALL REPORT('JETFIN',2,'E')
         ierr = -5
         goto 999
      ENDIF


*======  normal YKERN with fixed YCUT
      IF(imode.GE.1.AND.imode.LE.12) THEN

         IF(imode.GE.1.AND.imode.LE.6) THEN
            jmode=imode
            CALL ykern(jmode,npar,5,ppar,ierr)
            IF(ierr.NE.0) THEN
               WRITE(*,'(A,I3,I10)')'YKERN ERROR 1',i,ierr
*               CALL REPORT('JETFIN',3,'E')
               goto 999
            ENDIF
            CALL ynjet(ycut,njet,ierr) ! using input YCUT
            IF(ierr.NE.0) THEN
               WRITE(*,'(A,I3,I10)')'YNJET ERROR 2',i,ierr
*               CALL REPORT('JETFIN',4,'E')
               goto 999
            ENDIF
            IF(njet.GT.10) THEN
               WRITE(*,'(A,I3,I10)')
     +              'NJET EXCEED 10 USE 10',njet,imode
*               CALL REPORT('JETFIN',5,'W')
               njet = 10
            ENDIF
            CALL yasso(njet,pjj,ipass,ierr)
            IF(ierr.NE.0) THEN
               WRITE(*,'(A,I3,I10)')'YASSO ERROR 1',i,ierr
*               CALL REPORT('JETFIN',6,'E')
               goto 999
            ENDIF
            DO k=1,njet
               CALL ucopy(pjj(1,k),pjet(1,k),4)
            ENDDO

         ELSEIF(imode.EQ.7) THEN ! Cambridge
            CALL pxcamj(5,npar,ppar,ycut,njet,ipass,p4,ierr)
            IF(ierr.NE.0) THEN
               WRITE(*,'(A,I3,I10)')'PXCAMJ ERROR ',njet,ierr
*               CALL REPORT('JETFIN',7,'E')
               goto 999
            ENDIF
            DO k=1,njet
               CALL ucopy(p4(1,k),pjet(1,k),4)
               pjet(5,k) = sqrt(max(0.,
     +           pjet(4,k)**2-pjet(1,k)**2-pjet(2,k)**2-pjet(3,k)**2))
            ENDDO

         ELSEIF(imode.GE.8.AND.imode.LE.11) THEN ! LUCLUS default
C     ! YCUT==XMIN
            jmode = imode - 7
            CALL pxlcl5(npar,5,ppar,jmode,ycut,1,10,
     +           njet,pjet,ipass,ijmul,ierr)
            IF(ierr.NE.0) THEN
               WRITE(*,'(A,I3,I10)')'PXLCL5 ERROR ',njet,ierr
*               CALL REPORT('JETFIN',8,'E')
               goto 999
            ENDIF
            DO k=1,njet
               pjet(5,k) = sqrt(max(0.,
     +           pjet(4,k)**2-pjet(1,k)**2-pjet(2,k)**2-pjet(3,k)**2))
            ENDDO

         ELSEIF(imode.EQ.12) THEN ! CONE
            rin   = r0
            epsin = eps0
            CALL pxcone(npar,5,ppar,rin,epsin,10,
     +           njet,pjet,ipass,ijmul,ierr)
            IF(ierr.NE.0) THEN
               WRITE(*,'(A,I3,I10)')'PXCONE ERROR ',njet,ierr
*               CALL REPORT('JETFIN',9,'E')
               goto 999
            ENDIF
            DO k=1,njet
               pjet(5,k) = sqrt(max(0.,
     +           pjet(4,k)**2-pjet(1,k)**2-pjet(2,k)**2-pjet(3,k)**2))
            ENDDO

         ENDIF

      ELSEIF(imode.GE.101.AND.imode.LE.112) THEN
         njet = njetrq

         IF(imode.GE.101.AND.imode.LE.106) THEN
            jmode=imode-100
            CALL ykern(jmode,npar,5,ppar,ierr) ! DURHAM
            IF(ierr.NE.0) THEN
               WRITE(*,'(A,I5,I10)')'YKERN ERROR 2',imode,ierr
*               CALL REPORT('JETFIN',10,'E')
               goto 999
            ENDIF
            CALL yyjet(njet,y45,y34,ierr)
            IF(ierr.NE.0) THEN
               WRITE(*,'(A,I3,I10)')'YYJET ERROR 1',i,ierr
*               CALL REPORT('JETFIN',11,'E')
               goto 999
            ENDIF

*           temp
C            write(*,*)'NJET=',NJET,NPAR0,NPAR,IMODE,JMODE,PPAR(4,NPAR)

            CALL yasso(njet,pjj,ipass,ierr)
C            write(*,*)'over YASSO'

            IF(ierr.NE.0) THEN
               WRITE(*,'(A,I3,I10)')'YASSO ERROR 1',i,ierr
*               CALL REPORT('JETFIN',12,'E')
               goto 999
            ENDIF
            DO k=1,njet
               CALL ucopy(pjj(1,k),pjet(1,k),4)
               pjet(5,k) = sqrt(max(0.,
     +           pjet(4,k)**2-pjet(1,k)**2-pjet(2,k)**2-pjet(3,k)**2))
            ENDDO

         ELSEIF(imode.EQ.107) THEN ! CAMBRIDGE WITH FIXED NJET
            CALL ckern(5,npar,ppar,njet,ierr)
            IF(ierr.NE.0) THEN
               WRITE(*,'(A,I5,I10)')'CKERN ERROR',imode,ierr
*               CALL REPORT('JETFIN',13,'E')
               goto 999
            ENDIF
            CALL cyjet(njet,y45,y34,ierr)
            IF(ierr.NE.0) THEN
               WRITE(*,'(A,I3,I10)')'CYJET ERROR',i,ierr
*               CALL REPORT('JETFIN',14,'E')
               goto 999
            ENDIF
            CALL casso(njet,p4,ipass,ierr)
            IF(ierr.NE.0) THEN
               WRITE(*,'(A,I3,I10)')'CASSO ERROR 1',i,ierr
*               CALL REPORT('JETFIN',15,'E')
               goto 999
            ENDIF
            DO k=1,njet
               CALL ucopy(p4(1,k),pjet(1,k),4)
               pjet(5,k) = sqrt(max(0.,
     +           pjet(4,k)**2-pjet(1,k)**2-pjet(2,k)**2-pjet(3,k)**2))
            ENDDO

         ELSEIF(imode.GE.108.AND.imode.LE.111) THEN ! LUCLUS NOT YET
            jmode = imode - 107
            ydum = 50.0
            IF(imode.EQ.111) ydum = 0.99
            njdum = njet
            CALL pxlcl5(npar,5,ppar,jmode,ydum,njdum,10,
     +           njet,pjet,ipass,ijmul,ierr)
            IF(ierr.NE.0) THEN
               WRITE(*,'(A,I3,I10)')'PXLCL5 ERROR ',njet,ierr
*               CALL REPORT('JETFIN',8,'E')
               goto 999
            ENDIF
            DO k=1,njet
               pjet(5,k) = sqrt(max(0.,
     +          pjet(4,k)**2-pjet(1,k)**2-pjet(2,k)**2-pjet(3,k)**2))
            ENDDO

         ELSE IF(imode.EQ.112) THEN
            epsout = 10.0       ! EPS = 10 GEV
            CALL sycone(njet,npar,5,ppar,rout,epsout,
     +           10,njetout,pjet,ipass,ijmul,ierr)
            IF(ierr.NE.0) THEN
               WRITE(*,'(A,I3,I10)')'SYCONE ERROR',njet,ierr
*               CALL REPORT('JETFIN',17,'E')
               goto 999
            ENDIF
            IF(njet.NE.njetout) THEN
               WRITE(*,'(A,I3,I10)')
     +              'SYCONE NJ NOT MATCH',njet,njetout
*               CALL REPORT('JETFIN',18,'E')
               ierr = 1
               goto 999
            ENDIF
            DO j=1,npar
               IF(ipass(j).LE.0) THEN
                  ipass(j)=0
               ENDIF
            ENDDO
            y34 = rout
            y45 = epsout
         ENDIF
      ELSE
         WRITE(*,'(A,I5,I10)')'NO JET ALGORITHM',imode,ierr
*         CALL REPORT('JETFIN',19,'E')
         ierr = -999
         goto 999
      ENDIF

      DO i=1,npar
         IF(ipass(i).GT.njet.OR.ipass(i).LT.1) THEN
            ipass(i) = 0
         ENDIF
      ENDDO
      k = 0
      DO i=1,npar0
         IF(iuse(i).GT.0) THEN
            k = k + 1
            ipass0(i) = ipass(k)
         ENDIF
      ENDDO
      DO k=1,njet
         pjet(5,k) = sqrt(max(0.,
     +        pjet(4,k)**2-pjet(1,k)**2-pjet(2,k)**2-pjet(3,k)**2))
      ENDDO
      DO k=1,njet
         CALL ucopy(pjet(1,k),pjet6(1,k),5)
         pjet6(6,k) = sqrt(pjet(1,k)**2+pjet(2,k)**2+pjet(3,k)**2)
      ENDDO

      RETURN

 999  CONTINUE
      write(*,*)' BAD OK1',njet,npar0,imode,ierr,njetrq
      njet = 0
      CALL vzero(pjet6,6*10)
      CALL vzero(ipass0,npar0)
      y34 = 0.
      y45 = 0.
C      write(*,*)' BAD OK2'

      RETURN

      END