yasso.f

Go to the documentation of this file.

CDECK  ID>, YASSO.
      SUBROUTINE yasso(NJET,PNJ,BL,IERR)
C
C  ROUTINE TO RETURN THE ASSIGNMENT OF PARTICLES TO JET AXES, FOR
C  CLASSIFICATION AS N-JET (FOR PARTICLE K IN MOMENTUM ARRAY,
C  J=BL(K) POINTS TO JET NUMBER J IN ARRAY PNJ).
C  JETS ARE ORDERED ACCORDING TO THEIR ENERGIES: E1 >= E2 >= ...
C
C  LAST MOD  : 28-Jul-99
C
C  Modification Log.
C  28-Jul-99 D. Chrisman, ITAG and IREORD are now dimensioned with NJETMX
C                         elements.
C  08-Oct-97 D. Chrisman, Increase NYCLMX from 250 to 500.
C  21-Jun-98 D. Chrisman, Want to be able to handle more than 10 jets.
C                         Introduce parameter NJETMX. Use this
C                         in declaration of PJET, YREC and PNJ in order to
C                         remove hard coded numbers.
C
      IMPLICIT NONE
C     IMPLICIT NONE
      INTEGER nyclmx,njetmx,njet,ierr,imodeo,njeto,nto,icheck,i,j,k,n
      INTEGER i1,i2
      parameter(nyclmx = 500, njetmx = 20)
      INTEGER histor(2,nyclmx),imax,bl(nyclmx),itag(njetmx),
     +         ireord(njetmx)
      REAL yrec(njetmx),pint(10,nyclmx),pjet(10,njetmx,njetmx)
      REAL pnj(10,njetmx),emax
      COMMON /ycl/yrec,pjet,histor
      COMMON /yint/ imodeo,nto,njeto,pint
      ierr = -1
C
CHECK IF CALL WAS MADE TO YKERN
C
      icheck = 0
      IF(imodeo.LE.0 .OR. imodeo.GT.7) THEN
        WRITE(6,111)
 111    FORMAT(' #### YASSO: YKERN MUST BE CALLED FIRST ! ####')
        icheck = -1
      ENDIF
C
CHECK IF INPUT MAKES SENSE
C
      IF(njet.LE.0 .OR. njet.GT.njetmx) THEN
        WRITE(6,1) njet
 1      FORMAT(' #### YASSO: REQUEST FOR NJET=',i4,
     +  ' NOT SUPPORTED ####')
        icheck = -1
      ENDIF
      IF(njet.GT.nto) THEN
        WRITE(6,2) njet,nto
 2      FORMAT(' #### YASSO:',i4,' JETS OUT OF',i4,' PARTICLES NOT',
     +  ' POSSIBLE. ####')
        icheck = -1
      ENDIF
      IF(icheck.NE.0) THEN
        DO 5001 i=1,10
          DO 5002 j=1,njetmx
            pnj(i,j) = -1.
 5002     CONTINUE
 5001   CONTINUE
        DO 5003 i=1,nto
          bl(i) = -1
 5003   CONTINUE
        RETURN
      ENDIF
C
      DO 5004 i=1,nto
        bl(i) = i
 5004 CONTINUE
C
      IF(njet.NE.nto) THEN
      DO 5005 i=nto,njet+1,-1
        i1 = histor(1,i)
        i2 = histor(2,i)
        DO 5006 n=1,nto
          IF(bl(n).EQ.i1) bl(n) = i2
          IF(i1.NE.i) THEN
            IF(bl(n).EQ.i) bl(n) = i1
          ENDIF
 5006   CONTINUE
 5005 CONTINUE
      ENDIF
C
C ORDER JETS ACCORDING TO THEIR ENERGY (FIRST IS LARGEST)
C AND CHANGE POINTERS ACCORDINGLY
C
      DO 5007 i=1,njet
        itag(i) = 1
 5007 CONTINUE
      DO 5008 i=1,njet
C       IF(ITAG(I).NE.0) THEN
          emax = 0.
          imax = 0
          DO 5009 j=1,njet
            IF(itag(j).NE.0 .AND. emax.LT.pjet(4,j,njet)) THEN
               emax = pjet(4,j,njet)
               imax = j
            ENDIF
 5009     CONTINUE
          IF(imax.LE.0) THEN
            WRITE(6,9)
 9          FORMAT(' #### YASSO: JET AXIS WITH ZERO OR NEGATIVE ',
     +      'ENERGY COMPONENT DETECTED; NO ORDERING DONE. ####')
            DO 5010 n=1,njet
              DO 5011 k=1,7
                pnj(k,n) = pjet(k,n,njet)
 5011         CONTINUE
 5010       CONTINUE
            RETURN
          ENDIF
          itag(imax) = 0
          ireord(imax) = i
C       ENDIF
 5008 CONTINUE
C
      DO 5012 n=1,njet
        DO 5013 k=1,7
          pnj(k,ireord(n)) = pjet(k,n,njet)
 5013   CONTINUE
 5012 CONTINUE
C
      DO 5014 i=1,nto
        bl(i) = ireord(bl(i))
 5014 CONTINUE
C
      ierr = 0
      RETURN
      END