hijsrt.f

Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file hijsrt.f

C
C
C
C********************************************************************
C Sort the jets associated with a nucleon in order of their
C rapdities
C********************************************************************
  SUBROUTINE hijsrt(JPJT,NPT)
  dimension kf(100),px(100),py(100),pz(100),pe(100),pm(100)
  dimension y(100),ip(100,2)
  common/hijjet1/npj(300),kfpj(300,500),pjpx(300,500),
     &                pjpy(300,500),pjpz(300,500),pjpe(300,500),
     &                pjpm(300,500),ntj(300),kftj(300,500),
     &                pjtx(300,500),pjty(300,500),pjtz(300,500),
     &                pjte(300,500),pjtm(300,500)
  SAVE  /hijjet1/
  IF(npt.EQ.2) go to 500
  jp=jpjt
  iq=0
  i=1
100 kf(i)=kfpj(jp,i)
  px(i)=pjpx(jp,i)
  py(i)=pjpy(jp,i)
  pz(i)=pjpz(jp,i)
  pe(i)=pjpe(jp,i)
  pm(i)=pjpm(jp,i)
  y(i-iq)=0.5*alog((abs(pe(i)+pz(i))+1.e-5)
     &          /(abs(pe(i)-pz(i))+1.e-5))
  ip(i-iq,1)=i
  ip(i-iq,2)=0
  IF(kf(i).NE.21) THEN
    ip(i-iq,2)=1
    iq=iq+1
    i=i+1
    kf(i)=kfpj(jp,i)
    px(i)=pjpx(jp,i)
    py(i)=pjpy(jp,i)
    pz(i)=pjpz(jp,i)
    pe(i)=pjpe(jp,i)
    pm(i)=pjpm(jp,i)
  ENDIF
  i=i+1
  IF(i.LE.npj(jp)) go to 100
      
  DO 200 i=1,npj(jp)-iq
  DO 200 j=i+1,npj(jp)-iq
    IF(y(i).GT.y(j)) go to 200
    ip1=ip(i,1)
    ip2=ip(i,2)
    ip(i,1)=ip(j,1)
    ip(i,2)=ip(j,2)
    ip(j,1)=ip1
    ip(j,2)=ip2
200 CONTINUE
C     ********sort in decending y
  iqq=0
  i=1
300 kfpj(jp,i)=kf(ip(i-iqq,1))
  pjpx(jp,i)=px(ip(i-iqq,1))
  pjpy(jp,i)=py(ip(i-iqq,1))
  pjpz(jp,i)=pz(ip(i-iqq,1))
  pjpe(jp,i)=pe(ip(i-iqq,1))
  pjpm(jp,i)=pm(ip(i-iqq,1))
  IF(ip(i-iqq,2).EQ.1) THEN
    kfpj(jp,i+1)=kf(ip(i-iqq,1)+1)
    pjpx(jp,i+1)=px(ip(i-iqq,1)+1)
    pjpy(jp,i+1)=py(ip(i-iqq,1)+1)
    pjpz(jp,i+1)=pz(ip(i-iqq,1)+1)
    pjpe(jp,i+1)=pe(ip(i-iqq,1)+1)
    pjpm(jp,i+1)=pm(ip(i-iqq,1)+1)
    i=i+1
    iqq=iqq+1
  ENDIF
  i=i+1
  IF(i.LE.npj(jp)) go to 300

  RETURN

500 jt=jpjt
  iq=0
  i=1
600 kf(i)=kftj(jt,i)
  px(i)=pjtx(jt,i)
  py(i)=pjty(jt,i)
  pz(i)=pjtz(jt,i)
  pe(i)=pjte(jt,i)
  pm(i)=pjtm(jt,i)
  y(i-iq)=0.5*alog((abs(pe(i)+pz(i))+1.e-5)
     &          /(abs(pe(i)-pz(i))+1.e-5))
  ip(i-iq,1)=i
  ip(i-iq,2)=0
  IF(kf(i).NE.21) THEN
    ip(i-iq,2)=1
    iq=iq+1
    i=i+1
    kf(i)=kftj(jt,i)
    px(i)=pjtx(jt,i)
    py(i)=pjty(jt,i)
    pz(i)=pjtz(jt,i)
    pe(i)=pjte(jt,i)
    pm(i)=pjtm(jt,i)
  ENDIF
  i=i+1
  IF(i.LE.ntj(jt)) go to 600
      
  DO 700 i=1,ntj(jt)-iq
  DO 700 j=i+1,ntj(jt)-iq
    IF(y(i).LT.y(j)) go to 700
    ip1=ip(i,1)
    ip2=ip(i,2)
    ip(i,1)=ip(j,1)
    ip(i,2)=ip(j,2)
    ip(j,1)=ip1
    ip(j,2)=ip2
700 CONTINUE
C     ********sort in acending y
  iqq=0
  i=1
800 kftj(jt,i)=kf(ip(i-iqq,1))
  pjtx(jt,i)=px(ip(i-iqq,1))
  pjty(jt,i)=py(ip(i-iqq,1))
  pjtz(jt,i)=pz(ip(i-iqq,1))
  pjte(jt,i)=pe(ip(i-iqq,1))
  pjtm(jt,i)=pm(ip(i-iqq,1))
  IF(ip(i-iqq,2).EQ.1) THEN
    kftj(jt,i+1)=kf(ip(i-iqq,1)+1)
    pjtx(jt,i+1)=px(ip(i-iqq,1)+1)
    pjty(jt,i+1)=py(ip(i-iqq,1)+1)
    pjtz(jt,i+1)=pz(ip(i-iqq,1)+1)
    pjte(jt,i+1)=pe(ip(i-iqq,1)+1)
    pjtm(jt,i+1)=pm(ip(i-iqq,1)+1)
    i=i+1
    iqq=iqq+1
  ENDIF
  i=i+1
  IF(i.LE.ntj(jt)) go to 800
  RETURN
  END