[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)
#define BLANKET_SAVE
#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)
bc676b8e	12	#define BLANKET_SAVE
e74335a4	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