HIJING/hijing1_36/hijsrt.F

   1 * $Id$
   2 C
   3 C
   4 C
   5 C********************************************************************
   6 C       Sort the jets associated with a nucleon in order of their
   7 C       rapdities
   8 C********************************************************************
   9         SUBROUTINE HIJSRT(JPJT,NPT)
  10         DIMENSION KF(100),PX(100),PY(100),PZ(100),PE(100),PM(100)
  11         DIMENSION Y(100),IP(100,2)
  12 #define BLANKET_SAVE
  13 #include "hijjet1.inc"
  14         SAVE
  15         IF(NPT.EQ.2) GO TO 500
  16         JP=JPJT
  17         IQ=0
  18         I=1
  19 100     KF(I)=KFPJ(JP,I)
  20         PX(I)=PJPX(JP,I)
  21         PY(I)=PJPY(JP,I)
  22         PZ(I)=PJPZ(JP,I)
  23         PE(I)=PJPE(JP,I)
  24         PM(I)=PJPM(JP,I)
  25         Y(I-IQ)=0.5*ALOG((ABS(PE(I)+PZ(I))+1.E-5)
  26      &          /(ABS(PE(I)-PZ(I))+1.E-5))
  27         IP(I-IQ,1)=I
  28         IP(I-IQ,2)=0
  29         IF(KF(I).NE.21) THEN
  30                 IP(I-IQ,2)=1
  31                 IQ=IQ+1
  32                 I=I+1
  33                 KF(I)=KFPJ(JP,I)
  34                 PX(I)=PJPX(JP,I)
  35                 PY(I)=PJPY(JP,I)
  36                 PZ(I)=PJPZ(JP,I)
  37                 PE(I)=PJPE(JP,I)
  38                 PM(I)=PJPM(JP,I)
  39         ENDIF
  40         I=I+1
  41         IF(I.LE.NPJ(JP)) GO TO 100
  42
  43         DO 200 I=1,NPJ(JP)-IQ
  44         DO 200 J=I+1,NPJ(JP)-IQ
  45                 IF(Y(I).GT.Y(J)) GO TO 200
  46                 IP1=IP(I,1)
  47                 IP2=IP(I,2)
  48                 IP(I,1)=IP(J,1)
  49                 IP(I,2)=IP(J,2)
  50                 IP(J,1)=IP1
  51                 IP(J,2)=IP2
  52 200     CONTINUE
  53 C                       ********sort in decending y
  54         IQQ=0
  55         I=1
  56 300     KFPJ(JP,I)=KF(IP(I-IQQ,1))
  57         PJPX(JP,I)=PX(IP(I-IQQ,1))
  58         PJPY(JP,I)=PY(IP(I-IQQ,1))
  59         PJPZ(JP,I)=PZ(IP(I-IQQ,1))
  60         PJPE(JP,I)=PE(IP(I-IQQ,1))
  61         PJPM(JP,I)=PM(IP(I-IQQ,1))
  62         IF(IP(I-IQQ,2).EQ.1) THEN
  63                 KFPJ(JP,I+1)=KF(IP(I-IQQ,1)+1)
  64                 PJPX(JP,I+1)=PX(IP(I-IQQ,1)+1)
  65                 PJPY(JP,I+1)=PY(IP(I-IQQ,1)+1)
  66                 PJPZ(JP,I+1)=PZ(IP(I-IQQ,1)+1)
  67                 PJPE(JP,I+1)=PE(IP(I-IQQ,1)+1)
  68                 PJPM(JP,I+1)=PM(IP(I-IQQ,1)+1)
  69                 I=I+1
  70                 IQQ=IQQ+1
  71         ENDIF
  72         I=I+1
  73         IF(I.LE.NPJ(JP)) GO TO 300
  74
  75         RETURN
  76
  77 500     JT=JPJT
  78         IQ=0
  79         I=1
  80 600     KF(I)=KFTJ(JT,I)
  81         PX(I)=PJTX(JT,I)
  82         PY(I)=PJTY(JT,I)
  83         PZ(I)=PJTZ(JT,I)
  84         PE(I)=PJTE(JT,I)
  85         PM(I)=PJTM(JT,I)
  86         Y(I-IQ)=0.5*ALOG((ABS(PE(I)+PZ(I))+1.E-5)
  87      &          /(ABS(PE(I)-PZ(I))+1.E-5))
  88         IP(I-IQ,1)=I
  89         IP(I-IQ,2)=0
  90         IF(KF(I).NE.21) THEN
  91                 IP(I-IQ,2)=1
  92                 IQ=IQ+1
  93                 I=I+1
  94                 KF(I)=KFTJ(JT,I)
  95                 PX(I)=PJTX(JT,I)
  96                 PY(I)=PJTY(JT,I)
  97                 PZ(I)=PJTZ(JT,I)
  98                 PE(I)=PJTE(JT,I)
  99                 PM(I)=PJTM(JT,I)
 100         ENDIF
 101         I=I+1
 102         IF(I.LE.NTJ(JT)) GO TO 600
 103
 104         DO 700 I=1,NTJ(JT)-IQ
 105         DO 700 J=I+1,NTJ(JT)-IQ
 106                 IF(Y(I).LT.Y(J)) GO TO 700
 107                 IP1=IP(I,1)
 108                 IP2=IP(I,2)
 109                 IP(I,1)=IP(J,1)
 110                 IP(I,2)=IP(J,2)
 111                 IP(J,1)=IP1
 112                 IP(J,2)=IP2
 113 700     CONTINUE
 114 C                       ********sort in acending y
 115         IQQ=0
 116         I=1
 117 800     KFTJ(JT,I)=KF(IP(I-IQQ,1))
 118         PJTX(JT,I)=PX(IP(I-IQQ,1))
 119         PJTY(JT,I)=PY(IP(I-IQQ,1))
 120         PJTZ(JT,I)=PZ(IP(I-IQQ,1))
 121         PJTE(JT,I)=PE(IP(I-IQQ,1))
 122         PJTM(JT,I)=PM(IP(I-IQQ,1))
 123         IF(IP(I-IQQ,2).EQ.1) THEN
 124                 KFTJ(JT,I+1)=KF(IP(I-IQQ,1)+1)
 125                 PJTX(JT,I+1)=PX(IP(I-IQQ,1)+1)
 126                 PJTY(JT,I+1)=PY(IP(I-IQQ,1)+1)
 127                 PJTZ(JT,I+1)=PZ(IP(I-IQQ,1)+1)
 128                 PJTE(JT,I+1)=PE(IP(I-IQQ,1)+1)
 129                 PJTM(JT,I+1)=PM(IP(I-IQQ,1)+1)
 130                 I=I+1
 131                 IQQ=IQQ+1
 132         ENDIF
 133         I=I+1
 134         IF(I.LE.NTJ(JT)) GO TO 800
 135         RETURN
 136         END