[u/mrichter/AliRoot.git] / HIJING / hijing1_36 / hijsrt.F

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