hijing/src/hijsrt.f

0001 C
0002 C
0003 C
0004 C********************************************************************
0005 C       Sort the jets associated with a nucleon in order of their
0006 C       rapdities
0007 C********************************************************************
0008         SUBROUTINE HIJSRT(JPJT,NPT)
0009         DIMENSION KF(100),PX(100),PY(100),PZ(100),PE(100),PM(100)
0010         DIMENSION Y(100),IP(100,2)
0011         COMMON/HIJJET1/NPJ(300),KFPJ(300,500),PJPX(300,500),
0012      &                PJPY(300,500),PJPZ(300,500),PJPE(300,500),
0013      &                PJPM(300,500),NTJ(300),KFTJ(300,500),
0014      &                PJTX(300,500),PJTY(300,500),PJTZ(300,500),
0015      &                PJTE(300,500),PJTM(300,500)
0016         SAVE  /HIJJET1/
0017         IF(NPT.EQ.2) GO TO 500
0018         JP=JPJT
0019         IQ=0
0020         I=1
0021 100     KF(I)=KFPJ(JP,I)
0022         PX(I)=PJPX(JP,I)
0023         PY(I)=PJPY(JP,I)
0024         PZ(I)=PJPZ(JP,I)
0025         PE(I)=PJPE(JP,I)
0026         PM(I)=PJPM(JP,I)
0027         Y(I-IQ)=0.5*ALOG((ABS(PE(I)+PZ(I))+1.E-5)
0028      &          /(ABS(PE(I)-PZ(I))+1.E-5))
0029         IP(I-IQ,1)=I
0030         IP(I-IQ,2)=0
0031         IF(KF(I).NE.21) THEN
0032                 IP(I-IQ,2)=1
0033                 IQ=IQ+1
0034                 I=I+1
0035                 KF(I)=KFPJ(JP,I)
0036                 PX(I)=PJPX(JP,I)
0037                 PY(I)=PJPY(JP,I)
0038                 PZ(I)=PJPZ(JP,I)
0039                 PE(I)=PJPE(JP,I)
0040                 PM(I)=PJPM(JP,I)
0041         ENDIF
0042         I=I+1
0043         IF(I.LE.NPJ(JP)) GO TO 100
0044
0045         DO 200 I=1,NPJ(JP)-IQ
0046         DO 200 J=I+1,NPJ(JP)-IQ
0047                 IF(Y(I).GT.Y(J)) GO TO 200
0048                 IP1=IP(I,1)
0049                 IP2=IP(I,2)
0050                 IP(I,1)=IP(J,1)
0051                 IP(I,2)=IP(J,2)
0052                 IP(J,1)=IP1
0053                 IP(J,2)=IP2
0054 200     CONTINUE
0055 C                       ********sort in decending y
0056         IQQ=0
0057         I=1
0058 300     KFPJ(JP,I)=KF(IP(I-IQQ,1))
0059         PJPX(JP,I)=PX(IP(I-IQQ,1))
0060         PJPY(JP,I)=PY(IP(I-IQQ,1))
0061         PJPZ(JP,I)=PZ(IP(I-IQQ,1))
0062         PJPE(JP,I)=PE(IP(I-IQQ,1))
0063         PJPM(JP,I)=PM(IP(I-IQQ,1))
0064         IF(IP(I-IQQ,2).EQ.1) THEN
0065                 KFPJ(JP,I+1)=KF(IP(I-IQQ,1)+1)
0066                 PJPX(JP,I+1)=PX(IP(I-IQQ,1)+1)
0067                 PJPY(JP,I+1)=PY(IP(I-IQQ,1)+1)
0068                 PJPZ(JP,I+1)=PZ(IP(I-IQQ,1)+1)
0069                 PJPE(JP,I+1)=PE(IP(I-IQQ,1)+1)
0070                 PJPM(JP,I+1)=PM(IP(I-IQQ,1)+1)
0071                 I=I+1
0072                 IQQ=IQQ+1
0073         ENDIF
0074         I=I+1
0075         IF(I.LE.NPJ(JP)) GO TO 300
0076
0077         RETURN
0078
0079 500     JT=JPJT
0080         IQ=0
0081         I=1
0082 600     KF(I)=KFTJ(JT,I)
0083         PX(I)=PJTX(JT,I)
0084         PY(I)=PJTY(JT,I)
0085         PZ(I)=PJTZ(JT,I)
0086         PE(I)=PJTE(JT,I)
0087         PM(I)=PJTM(JT,I)
0088         Y(I-IQ)=0.5*ALOG((ABS(PE(I)+PZ(I))+1.E-5)
0089      &          /(ABS(PE(I)-PZ(I))+1.E-5))
0090         IP(I-IQ,1)=I
0091         IP(I-IQ,2)=0
0092         IF(KF(I).NE.21) THEN
0093                 IP(I-IQ,2)=1
0094                 IQ=IQ+1
0095                 I=I+1
0096                 KF(I)=KFTJ(JT,I)
0097                 PX(I)=PJTX(JT,I)
0098                 PY(I)=PJTY(JT,I)
0099                 PZ(I)=PJTZ(JT,I)
0100                 PE(I)=PJTE(JT,I)
0101                 PM(I)=PJTM(JT,I)
0102         ENDIF
0103         I=I+1
0104         IF(I.LE.NTJ(JT)) GO TO 600
0105
0106         DO 700 I=1,NTJ(JT)-IQ
0107         DO 700 J=I+1,NTJ(JT)-IQ
0108                 IF(Y(I).LT.Y(J)) GO TO 700
0109                 IP1=IP(I,1)
0110                 IP2=IP(I,2)
0111                 IP(I,1)=IP(J,1)
0112                 IP(I,2)=IP(J,2)
0113                 IP(J,1)=IP1
0114                 IP(J,2)=IP2
0115 700     CONTINUE
0116 C                       ********sort in acending y
0117         IQQ=0
0118         I=1
0119 800     KFTJ(JT,I)=KF(IP(I-IQQ,1))
0120         PJTX(JT,I)=PX(IP(I-IQQ,1))
0121         PJTY(JT,I)=PY(IP(I-IQQ,1))
0122         PJTZ(JT,I)=PZ(IP(I-IQQ,1))
0123         PJTE(JT,I)=PE(IP(I-IQQ,1))
0124         PJTM(JT,I)=PM(IP(I-IQQ,1))
0125         IF(IP(I-IQQ,2).EQ.1) THEN
0126                 KFTJ(JT,I+1)=KF(IP(I-IQQ,1)+1)
0127                 PJTX(JT,I+1)=PX(IP(I-IQQ,1)+1)
0128                 PJTY(JT,I+1)=PY(IP(I-IQQ,1)+1)
0129                 PJTZ(JT,I+1)=PZ(IP(I-IQQ,1)+1)
0130                 PJTE(JT,I+1)=PE(IP(I-IQQ,1)+1)
0131                 PJTM(JT,I+1)=PM(IP(I-IQQ,1)+1)
0132                 I=I+1
0133                 IQQ=IQQ+1
0134         ENDIF
0135         I=I+1
0136         IF(I.LE.NTJ(JT)) GO TO 800
0137         RETURN
0138         END