]>
Commit | Line | Data |
---|---|---|
1 | * $Id$ | |
2 | C | |
3 | C | |
4 | C | |
5 | SUBROUTINE HIJHRD(JP,JT,JOUT,JFLG,IOPJET0) | |
6 | C | |
7 | C IOPTJET=1, ALL JET WILL FORM SINGLE STRING SYSTEM | |
8 | C 0, ONLY Q-QBAR JET FORM SINGLE STRING SYSTEM | |
9 | C*******Perform jets production and fragmentation when JP JT ******* | |
10 | C scatter. JOUT-> number of hard scatterings precede this one * | |
11 | C for the the same pair(JP,JT). JFLG->a flag to show whether * | |
12 | C jets can be produced (with valence quark=1,gluon=2, q-qbar=3)* | |
13 | C or not(0). Information of jets are in COMMON/ATTJET and * | |
14 | C /MINJET. ABS(NFP(JP,6)) is the total number jets produced by * | |
15 | C JP. If NFP(JP,6)<0 JP can not produce jet anymore. * | |
16 | C******************************************************************* | |
17 | DIMENSION IP(100,2),IPQ(50),IPB(50),IT(100,2),ITQ(50),ITB(50) | |
18 | #define BLANKET_SAVE | |
19 | #include "hijcrdn.inc" | |
20 | #include "hiparnt.inc" | |
21 | #include "hijdat.inc" | |
22 | #include "histrng.inc" | |
23 | #include "hijjet1.inc" | |
24 | #include "hijjet2.inc" | |
25 | #include "hijjet4.inc" | |
26 | C************************************ HIJING common block | |
27 | #include "lujets_hijing.inc" | |
28 | #include "ludat1_hijing.inc" | |
29 | #include "pysubs_hijing.inc" | |
30 | #include "pypars_hijing.inc" | |
31 | #include "pyint1_hijing.inc" | |
32 | #include "pyint2_hijing.inc" | |
33 | #include "pyint5_hijing.inc" | |
34 | #include "hipyint.inc" | |
35 | SAVE | |
36 | C*********************************** LU common block | |
37 | MXJT=500 | |
38 | C SIZE OF COMMON BLOCK FOR # OF PARTON PER STRING | |
39 | MXSG=900 | |
40 | C SIZE OF COMMON BLOCK FOR # OF SINGLE STRINGS | |
41 | MXSJ=100 | |
42 | C SIZE OF COMMON BLOCK FOR # OF PARTON PER SINGLE | |
43 | C STRING | |
44 | JFLG=0 | |
45 | IHNT2(11)=JP | |
46 | IHNT2(12)=JT | |
47 | C | |
48 | IOPJET=IOPJET0 | |
49 | IF(IOPJET.EQ.1.AND.(NFP(JP,6).NE.0.OR.NFT(JT,6).NE.0)) | |
50 | & IOPJET=0 | |
51 | IF(JP.GT.IHNT2(1) .OR. JT.GT.IHNT2(3)) RETURN | |
52 | IF(NFP(JP,6).LT.0 .OR. NFT(JT,6).LT.0) RETURN | |
53 | C ******** JP or JT can not produce jet anymore | |
54 | C | |
55 | IF(JOUT.EQ.0) THEN | |
56 | EPP=PP(JP,4)+PP(JP,3) | |
57 | EPM=PP(JP,4)-PP(JP,3) | |
58 | ETP=PT(JT,4)+PT(JT,3) | |
59 | ETM=PT(JT,4)-PT(JT,3) | |
60 | IF(EPP.LT.0.0) GO TO 1000 | |
61 | IF(EPM.LT.0.0) GO TO 1000 | |
62 | IF(ETP.LT.0.0) GO TO 1000 | |
63 | IF(ETM.LT.0.0) GO TO 1000 | |
64 | IF(EPP/(EPM+0.01).LE.ETP/(ETM+0.01)) RETURN | |
65 | ENDIF | |
66 | C ********for the first hard scattering of (JP,JT) | |
67 | C have collision only when Ycm(JP)>Ycm(JT) | |
68 | ||
69 | ECUT1=HIPR1(1)+HIPR1(8)+PP(JP,14)+PP(JP,15) | |
70 | ECUT2=HIPR1(1)+HIPR1(8)+PT(JT,14)+PT(JT,15) | |
71 | IF(PP(JP,4).LE.ECUT1) THEN | |
72 | NFP(JP,6)=-ABS(NFP(JP,6)) | |
73 | RETURN | |
74 | ENDIF | |
75 | IF(PT(JT,4).LE.ECUT2) THEN | |
76 | NFT(JT,6)=-ABS(NFT(JT,6)) | |
77 | RETURN | |
78 | ENDIF | |
79 | C *********must have enough energy to produce jets | |
80 | ||
81 | MISS=0 | |
82 | MISP=0 | |
83 | MIST=0 | |
84 | C | |
85 | IF(NFP(JP,10).EQ.0 .AND. NFT(JT,10).EQ.0) THEN | |
86 | MINT(44)=MINT4 | |
87 | MINT(45)=MINT5 | |
88 | XSEC(0,1)=ATXS(0) | |
89 | XSEC(11,1)=ATXS(11) | |
90 | XSEC(12,1)=ATXS(12) | |
91 | XSEC(28,1)=ATXS(28) | |
92 | DO 120 I=1,20 | |
93 | COEF(11,I)=ATCO(11,I) | |
94 | COEF(12,I)=ATCO(12,I) | |
95 | COEF(28,I)=ATCO(28,I) | |
96 | 120 CONTINUE | |
97 | ELSE | |
98 | ISUB11=0 | |
99 | ISUB12=0 | |
100 | ISUB28=0 | |
101 | IF(XSEC(11,1).NE.0) ISUB11=1 | |
102 | IF(XSEC(12,1).NE.0) ISUB12=1 | |
103 | IF(XSEC(28,1).NE.0) ISUB28=1 | |
104 | MINT(44)=MINT4-ISUB11-ISUB12-ISUB28 | |
105 | MINT(45)=MINT5-ISUB11-ISUB12-ISUB28 | |
106 | XSEC(0,1)=ATXS(0)-ATXS(11)-ATXS(12)-ATXS(28) | |
107 | XSEC(11,1)=0.0 | |
108 | XSEC(12,1)=0.0 | |
109 | XSEC(28,1)=0.0 | |
110 | DO 110 I=1,20 | |
111 | COEF(11,I)=0.0 | |
112 | COEF(12,I)=0.0 | |
113 | COEF(28,I)=0.0 | |
114 | 110 CONTINUE | |
115 | ENDIF | |
116 | C ********Scatter the valence quarks only once per NN | |
117 | C collision, | |
118 | C afterwards only gluon can have hard scattering. | |
119 | 155 CALL PYTHIA_HIJING | |
120 | JJ=MINT(31) | |
121 | IF(JJ.NE.1) GO TO 155 | |
122 | C *********one hard collision at a time | |
123 | IF(K(7,2).EQ.-K(8,2)) THEN | |
124 | QMASS2=(P(7,4)+P(8,4))**2-(P(7,1)+P(8,1))**2 | |
125 | & -(P(7,2)+P(8,2))**2-(P(7,3)+P(8,3))**2 | |
126 | QM=ULMASS_HIJING(K(7,2)) | |
127 | IF(QMASS2.LT.(2.0*QM+HIPR1(1))**2) GO TO 155 | |
128 | ENDIF | |
129 | C ********q-qbar jets must has minimum mass HIPR1(1) | |
130 | PXP=PP(JP,1)-P(3,1) | |
131 | PYP=PP(JP,2)-P(3,2) | |
132 | PZP=PP(JP,3)-P(3,3) | |
133 | PEP=PP(JP,4)-P(3,4) | |
134 | PXT=PT(JT,1)-P(4,1) | |
135 | PYT=PT(JT,2)-P(4,2) | |
136 | PZT=PT(JT,3)-P(4,3) | |
137 | PET=PT(JT,4)-P(4,4) | |
138 | ||
139 | IF(PEP.LE.ECUT1) THEN | |
140 | MISP=MISP+1 | |
141 | IF(MISP.LT.50) GO TO 155 | |
142 | NFP(JP,6)=-ABS(NFP(JP,6)) | |
143 | RETURN | |
144 | ENDIF | |
145 | IF(PET.LE.ECUT2) THEN | |
146 | MIST=MIST+1 | |
147 | IF(MIST.LT.50) GO TO 155 | |
148 | NFT(JT,6)=-ABS(NFT(JT,6)) | |
149 | RETURN | |
150 | ENDIF | |
151 | C ******** if the remain energy<ECUT the proj or targ | |
152 | C can not produce jet anymore | |
153 | ||
154 | WP=PEP+PZP+PET+PZT | |
155 | WM=PEP-PZP+PET-PZT | |
156 | IF(WP.LT.0.0 .OR. WM.LT.0.0) THEN | |
157 | MISS=MISS+1 | |
158 | IF(MISS.LT.50) GO TO 155 | |
159 | RETURN | |
160 | ENDIF | |
161 | C ********the total W+, W- must be positive | |
162 | SW=WP*WM | |
163 | AMPX=SQRT((ECUT1-HIPR1(8))**2+PXP**2+PYP**2+0.01) | |
164 | AMTX=SQRT((ECUT2-HIPR1(8))**2+PXT**2+PYT**2+0.01) | |
165 | SXX=(AMPX+AMTX)**2 | |
166 | IF(SW.LT.SXX.OR.VINT(43).LT.HIPR1(1)) THEN | |
167 | MISS=MISS+1 | |
168 | IF(MISS.LT.50) GO TO 155 | |
169 | RETURN | |
170 | ENDIF | |
171 | C ********the proj and targ remnants must have at least | |
172 | C a CM energy that can produce two strings | |
173 | C with minimum mass HIPR1(1)(see HIJSFT HIJFRG) | |
174 | C | |
175 | HINT1(41)=P(7,1) | |
176 | HINT1(42)=P(7,2) | |
177 | HINT1(43)=P(7,3) | |
178 | HINT1(44)=P(7,4) | |
179 | HINT1(45)=P(7,5) | |
180 | HINT1(46)=SQRT(P(7,1)**2+P(7,2)**2) | |
181 | HINT1(51)=P(8,1) | |
182 | HINT1(52)=P(8,2) | |
183 | HINT1(53)=P(8,3) | |
184 | HINT1(54)=P(8,4) | |
185 | HINT1(55)=P(8,5) | |
186 | HINT1(56)=SQRT(P(8,1)**2+P(8,2)**2) | |
187 | IHNT2(14)=K(7,2) | |
188 | IHNT2(15)=K(8,2) | |
189 | C | |
190 | PINIRAD=(1.0-EXP(-2.0*(VINT(47)-HIDAT(1)))) | |
191 | & /(1.0+EXP(-2.0*(VINT(47)-HIDAT(1)))) | |
192 | I_INIRAD=0 | |
193 | IF(RLU_HIJING(0).LE.PINIRAD) I_INIRAD=1 | |
194 | IF(K(7,2).EQ.-K(8,2)) GO TO 190 | |
195 | IF(K(7,2).EQ.21.AND.K(8,2).EQ.21.AND.IOPJET.EQ.1) GO TO 190 | |
196 | C******************************************************************* | |
197 | C gluon jets are going to be connectd with | |
198 | C the final leading string of quark-aintquark | |
199 | C******************************************************************* | |
200 | JFLG=2 | |
201 | JPP=0 | |
202 | LPQ=0 | |
203 | LPB=0 | |
204 | JTT=0 | |
205 | LTQ=0 | |
206 | LTB=0 | |
207 | IS7=0 | |
208 | IS8=0 | |
209 | HINT1(47)=0.0 | |
210 | HINT1(48)=0.0 | |
211 | HINT1(49)=0.0 | |
212 | HINT1(50)=0.0 | |
213 | HINT1(67)=0.0 | |
214 | HINT1(68)=0.0 | |
215 | HINT1(69)=0.0 | |
216 | HINT1(70)=0.0 | |
217 | DO 180 I=9,N | |
218 | IF(K(I,3).EQ.1 .OR. K(I,3).EQ.2.OR. | |
219 | & ABS(K(I,2)).GT.30) GO TO 180 | |
220 | C************************************************************ | |
221 | IF(K(I,3).EQ.7) THEN | |
222 | HINT1(47)=HINT1(47)+P(I,1) | |
223 | HINT1(48)=HINT1(48)+P(I,2) | |
224 | HINT1(49)=HINT1(49)+P(I,3) | |
225 | HINT1(50)=HINT1(50)+P(I,4) | |
226 | ENDIF | |
227 | IF(K(I,3).EQ.8) THEN | |
228 | HINT1(67)=HINT1(67)+P(I,1) | |
229 | HINT1(68)=HINT1(68)+P(I,2) | |
230 | HINT1(69)=HINT1(69)+P(I,3) | |
231 | HINT1(70)=HINT1(70)+P(I,4) | |
232 | ENDIF | |
233 | C************************modifcation made on Apr 10. 1996***** | |
234 | IF(K(I,2).GT.21.AND.K(I,2).LE.30) THEN | |
235 | NDR=NDR+1 | |
236 | IADR(NDR,1)=JP | |
237 | IADR(NDR,2)=JT | |
238 | KFDR(NDR)=K(I,2) | |
239 | PDR(NDR,1)=P(I,1) | |
240 | PDR(NDR,2)=P(I,2) | |
241 | PDR(NDR,3)=P(I,3) | |
242 | PDR(NDR,4)=P(I,4) | |
243 | PDR(NDR,5)=P(I,5) | |
244 | C************************************************************ | |
245 | GO TO 180 | |
246 | C************************correction made on Oct. 14,1994***** | |
247 | ENDIF | |
248 | IF(K(I,3).EQ.7.OR.K(I,3).EQ.3) THEN | |
249 | IF(K(I,3).EQ.7.AND.K(I,2).NE.21.AND.K(I,2).EQ.K(7,2) | |
250 | & .AND.IS7.EQ.0) THEN | |
251 | PP(JP,10)=P(I,1) | |
252 | PP(JP,11)=P(I,2) | |
253 | PP(JP,12)=P(I,3) | |
254 | PZP=PZP+P(I,3) | |
255 | PEP=PEP+P(I,4) | |
256 | NFP(JP,10)=1 | |
257 | IS7=1 | |
258 | GO TO 180 | |
259 | ENDIF | |
260 | IF(K(I,3).EQ.3.AND.(K(I,2).NE.21.OR. | |
261 | & I_INIRAD.EQ.0)) THEN | |
262 | PXP=PXP+P(I,1) | |
263 | PYP=PYP+P(I,2) | |
264 | PZP=PZP+P(I,3) | |
265 | PEP=PEP+P(I,4) | |
266 | GO TO 180 | |
267 | ENDIF | |
268 | JPP=JPP+1 | |
269 | IP(JPP,1)=I | |
270 | IP(JPP,2)=0 | |
271 | IF(K(I,2).NE.21) THEN | |
272 | IF(K(I,2).GT.0) THEN | |
273 | LPQ=LPQ+1 | |
274 | IPQ(LPQ)=JPP | |
275 | IP(JPP,2)=LPQ | |
276 | ELSE IF(K(I,2).LT.0) THEN | |
277 | LPB=LPB+1 | |
278 | IPB(LPB)=JPP | |
279 | IP(JPP,2)=-LPB | |
280 | ENDIF | |
281 | ENDIF | |
282 | ELSE IF(K(I,3).EQ.8.OR.K(I,3).EQ.4) THEN | |
283 | IF(K(I,3).EQ.8.AND.K(I,2).NE.21.AND.K(I,2).EQ.K(8,2) | |
284 | & .AND.IS8.EQ.0) THEN | |
285 | PT(JT,10)=P(I,1) | |
286 | PT(JT,11)=P(I,2) | |
287 | PT(JT,12)=P(I,3) | |
288 | PZT=PZT+P(I,3) | |
289 | PET=PET+P(I,4) | |
290 | NFT(JT,10)=1 | |
291 | IS8=1 | |
292 | GO TO 180 | |
293 | ENDIF | |
294 | IF(K(I,3).EQ.4.AND.(K(I,2).NE.21.OR. | |
295 | & I_INIRAD.EQ.0)) THEN | |
296 | PXT=PXT+P(I,1) | |
297 | PYT=PYT+P(I,2) | |
298 | PZT=PZT+P(I,3) | |
299 | PET=PET+P(I,4) | |
300 | GO TO 180 | |
301 | ENDIF | |
302 | JTT=JTT+1 | |
303 | IT(JTT,1)=I | |
304 | IT(JTT,2)=0 | |
305 | IF(K(I,2).NE.21) THEN | |
306 | IF(K(I,2).GT.0) THEN | |
307 | LTQ=LTQ+1 | |
308 | ITQ(LTQ)=JTT | |
309 | IT(JTT,2)=LTQ | |
310 | ELSE IF(K(I,2).LT.0) THEN | |
311 | LTB=LTB+1 | |
312 | ITB(LTB)=JTT | |
313 | IT(JTT,2)=-LTB | |
314 | ENDIF | |
315 | ENDIF | |
316 | ENDIF | |
317 | 180 CONTINUE | |
318 | c | |
319 | c | |
320 | IF(LPQ.NE.LPB .OR. LTQ.NE.LTB) THEN | |
321 | MISS=MISS+1 | |
322 | IF(MISS.LE.50) GO TO 155 | |
323 | WRITE(6,*) ' Q -QBAR NOT MATCHED IN HIJHRD' | |
324 | JFLG=0 | |
325 | RETURN | |
326 | ENDIF | |
327 | C****The following will rearrange the partons so that a quark is*** | |
328 | C****allways followed by an anti-quark **************************** | |
329 | ||
330 | J=0 | |
331 | 181 J=J+1 | |
332 | IF(J.GT.JPP) GO TO 182 | |
333 | IF(IP(J,2).EQ.0) THEN | |
334 | GO TO 181 | |
335 | ELSE IF(IP(J,2).NE.0) THEN | |
336 | LP=ABS(IP(J,2)) | |
337 | IP1=IP(J,1) | |
338 | IP2=IP(J,2) | |
339 | IP(J,1)=IP(IPQ(LP),1) | |
340 | IP(J,2)=IP(IPQ(LP),2) | |
341 | IP(IPQ(LP),1)=IP1 | |
342 | IP(IPQ(LP),2)=IP2 | |
343 | IF(IP2.GT.0) THEN | |
344 | IPQ(IP2)=IPQ(LP) | |
345 | ELSE IF(IP2.LT.0) THEN | |
346 | IPB(-IP2)=IPQ(LP) | |
347 | ENDIF | |
348 | C ********replace J with a quark | |
349 | IP1=IP(J+1,1) | |
350 | IP2=IP(J+1,2) | |
351 | IP(J+1,1)=IP(IPB(LP),1) | |
352 | IP(J+1,2)=IP(IPB(LP),2) | |
353 | IP(IPB(LP),1)=IP1 | |
354 | IP(IPB(LP),2)=IP2 | |
355 | IF(IP2.GT.0) THEN | |
356 | IPQ(IP2)=IPB(LP) | |
357 | ELSE IF(IP2.LT.0) THEN | |
358 | IPB(-IP2)=IPB(LP) | |
359 | ENDIF | |
360 | C ******** replace J+1 with anti-quark | |
361 | J=J+1 | |
362 | GO TO 181 | |
363 | ENDIF | |
364 | ||
365 | 182 J=0 | |
366 | 183 J=J+1 | |
367 | IF(J.GT.JTT) GO TO 184 | |
368 | IF(IT(J,2).EQ.0) THEN | |
369 | GO TO 183 | |
370 | ELSE IF(IT(J,2).NE.0) THEN | |
371 | LT=ABS(IT(J,2)) | |
372 | IT1=IT(J,1) | |
373 | IT2=IT(J,2) | |
374 | IT(J,1)=IT(ITQ(LT),1) | |
375 | IT(J,2)=IT(ITQ(LT),2) | |
376 | IT(ITQ(LT),1)=IT1 | |
377 | IT(ITQ(LT),2)=IT2 | |
378 | IF(IT2.GT.0) THEN | |
379 | ITQ(IT2)=ITQ(LT) | |
380 | ELSE IF(IT2.LT.0) THEN | |
381 | ITB(-IT2)=ITQ(LT) | |
382 | ENDIF | |
383 | C ********replace J with a quark | |
384 | IT1=IT(J+1,1) | |
385 | IT2=IT(J+1,2) | |
386 | IT(J+1,1)=IT(ITB(LT),1) | |
387 | IT(J+1,2)=IT(ITB(LT),2) | |
388 | IT(ITB(LT),1)=IT1 | |
389 | IT(ITB(LT),2)=IT2 | |
390 | IF(IT2.GT.0) THEN | |
391 | ITQ(IT2)=ITB(LT) | |
392 | ELSE IF(IT2.LT.0) THEN | |
393 | ITB(-IT2)=ITB(LT) | |
394 | ENDIF | |
395 | C ******** replace J+1 with anti-quark | |
396 | J=J+1 | |
397 | GO TO 183 | |
398 | ||
399 | ENDIF | |
400 | ||
401 | 184 CONTINUE | |
402 | IF(NPJ(JP)+JPP.GT.MXJT.OR.NTJ(JT)+JTT.GT.MXJT) THEN | |
403 | JFLG=0 | |
404 | WRITE(6,*) 'number of partons per string exceeds' | |
405 | WRITE(6,*) 'the common block size' | |
406 | RETURN | |
407 | ENDIF | |
408 | C ********check the bounds of common blocks | |
409 | DO 186 J=1,JPP | |
410 | KFPJ(JP,NPJ(JP)+J)=K(IP(J,1),2) | |
411 | PJPX(JP,NPJ(JP)+J)=P(IP(J,1),1) | |
412 | PJPY(JP,NPJ(JP)+J)=P(IP(J,1),2) | |
413 | PJPZ(JP,NPJ(JP)+J)=P(IP(J,1),3) | |
414 | PJPE(JP,NPJ(JP)+J)=P(IP(J,1),4) | |
415 | PJPM(JP,NPJ(JP)+J)=P(IP(J,1),5) | |
416 | 186 CONTINUE | |
417 | NPJ(JP)=NPJ(JP)+JPP | |
418 | DO 188 J=1,JTT | |
419 | KFTJ(JT,NTJ(JT)+J)=K(IT(J,1),2) | |
420 | PJTX(JT,NTJ(JT)+J)=P(IT(J,1),1) | |
421 | PJTY(JT,NTJ(JT)+J)=P(IT(J,1),2) | |
422 | PJTZ(JT,NTJ(JT)+J)=P(IT(J,1),3) | |
423 | PJTE(JT,NTJ(JT)+J)=P(IT(J,1),4) | |
424 | PJTM(JT,NTJ(JT)+J)=P(IT(J,1),5) | |
425 | 188 CONTINUE | |
426 | NTJ(JT)=NTJ(JT)+JTT | |
427 | GO TO 900 | |
428 | C***************************************************************** | |
429 | CThis is the case of a quark-antiquark jet it will fragment alone | |
430 | C**************************************************************** | |
431 | 190 JFLG=3 | |
432 | IF(K(7,2).NE.21.AND.K(8,2).NE.21.AND. | |
433 | & K(7,2)*K(8,2).GT.0) GO TO 155 | |
434 | JPP=0 | |
435 | LPQ=0 | |
436 | LPB=0 | |
437 | DO 200 I=9,N | |
438 | IF(K(I,3).EQ.1.OR.K(I,3).EQ.2.OR. | |
439 | & ABS(K(I,2)).GT.30) GO TO 200 | |
440 | IF(K(I,2).GT.21.AND.K(I,2).LE.30) THEN | |
441 | NDR=NDR+1 | |
442 | IADR(NDR,1)=JP | |
443 | IADR(NDR,2)=JT | |
444 | KFDR(NDR)=K(I,2) | |
445 | PDR(NDR,1)=P(I,1) | |
446 | PDR(NDR,2)=P(I,2) | |
447 | PDR(NDR,3)=P(I,3) | |
448 | PDR(NDR,4)=P(I,4) | |
449 | PDR(NDR,5)=P(I,5) | |
450 | C************************************************************ | |
451 | GO TO 200 | |
452 | C************************correction made on Oct. 14,1994***** | |
453 | ENDIF | |
454 | IF(K(I,3).EQ.3.AND.(K(I,2).NE.21.OR. | |
455 | & I_INIRAD.EQ.0)) THEN | |
456 | PXP=PXP+P(I,1) | |
457 | PYP=PYP+P(I,2) | |
458 | PZP=PZP+P(I,3) | |
459 | PEP=PEP+P(I,4) | |
460 | GO TO 200 | |
461 | ENDIF | |
462 | IF(K(I,3).EQ.4.AND.(K(I,2).NE.21.OR. | |
463 | & I_INIRAD.EQ.0)) THEN | |
464 | PXT=PXT+P(I,1) | |
465 | PYT=PYT+P(I,2) | |
466 | PZT=PZT+P(I,3) | |
467 | PET=PET+P(I,4) | |
468 | GO TO 200 | |
469 | ENDIF | |
470 | JPP=JPP+1 | |
471 | IP(JPP,1)=I | |
472 | IP(JPP,2)=0 | |
473 | IF(K(I,2).NE.21) THEN | |
474 | IF(K(I,2).GT.0) THEN | |
475 | LPQ=LPQ+1 | |
476 | IPQ(LPQ)=JPP | |
477 | IP(JPP,2)=LPQ | |
478 | ELSE IF(K(I,2).LT.0) THEN | |
479 | LPB=LPB+1 | |
480 | IPB(LPB)=JPP | |
481 | IP(JPP,2)=-LPB | |
482 | ENDIF | |
483 | ENDIF | |
484 | 200 CONTINUE | |
485 | IF(LPQ.NE.LPB) THEN | |
486 | MISS=MISS+1 | |
487 | IF(MISS.LE.50) GO TO 155 | |
488 | WRITE(6,*) LPQ,LPB, 'Q-QBAR NOT CONSERVED OR NOT MATCHED' | |
489 | JFLG=0 | |
490 | RETURN | |
491 | ENDIF | |
492 | ||
493 | C**** The following will rearrange the partons so that a quark is*** | |
494 | C**** allways followed by an anti-quark **************************** | |
495 | J=0 | |
496 | 220 J=J+1 | |
497 | IF(J.GT.JPP) GO TO 222 | |
498 | IF(IP(J,2).EQ.0) GO TO 220 | |
499 | LP=ABS(IP(J,2)) | |
500 | IP1=IP(J,1) | |
501 | IP2=IP(J,2) | |
502 | IP(J,1)=IP(IPQ(LP),1) | |
503 | IP(J,2)=IP(IPQ(LP),2) | |
504 | IP(IPQ(LP),1)=IP1 | |
505 | IP(IPQ(LP),2)=IP2 | |
506 | IF(IP2.GT.0) THEN | |
507 | IPQ(IP2)=IPQ(LP) | |
508 | ELSE IF(IP2.LT.0) THEN | |
509 | IPB(-IP2)=IPQ(LP) | |
510 | ENDIF | |
511 | IPQ(LP)=J | |
512 | C ********replace J with a quark | |
513 | IP1=IP(J+1,1) | |
514 | IP2=IP(J+1,2) | |
515 | IP(J+1,1)=IP(IPB(LP),1) | |
516 | IP(J+1,2)=IP(IPB(LP),2) | |
517 | IP(IPB(LP),1)=IP1 | |
518 | IP(IPB(LP),2)=IP2 | |
519 | IF(IP2.GT.0) THEN | |
520 | IPQ(IP2)=IPB(LP) | |
521 | ELSE IF(IP2.LT.0) THEN | |
522 | IPB(-IP2)=IPB(LP) | |
523 | ENDIF | |
524 | C ******** replace J+1 with an anti-quark | |
525 | IPB(LP)=J+1 | |
526 | J=J+1 | |
527 | GO TO 220 | |
528 | ||
529 | 222 CONTINUE | |
530 | IF(LPQ.GE.1) THEN | |
531 | DO 240 L0=2,LPQ | |
532 | IP1=IP(2*L0-3,1) | |
533 | IP2=IP(2*L0-3,2) | |
534 | IP(2*L0-3,1)=IP(IPQ(L0),1) | |
535 | IP(2*L0-3,2)=IP(IPQ(L0),2) | |
536 | IP(IPQ(L0),1)=IP1 | |
537 | IP(IPQ(L0),2)=IP2 | |
538 | IF(IP2.GT.0) THEN | |
539 | IPQ(IP2)=IPQ(L0) | |
540 | ELSE IF(IP2.LT.0) THEN | |
541 | IPB(-IP2)=IPQ(L0) | |
542 | ENDIF | |
543 | IPQ(L0)=2*L0-3 | |
544 | C | |
545 | IP1=IP(2*L0-2,1) | |
546 | IP2=IP(2*L0-2,2) | |
547 | IP(2*L0-2,1)=IP(IPB(L0),1) | |
548 | IP(2*L0-2,2)=IP(IPB(L0),2) | |
549 | IP(IPB(L0),1)=IP1 | |
550 | IP(IPB(L0),2)=IP2 | |
551 | IF(IP2.GT.0) THEN | |
552 | IPQ(IP2)=IPB(L0) | |
553 | ELSE IF(IP2.LT.0) THEN | |
554 | IPB(-IP2)=IPB(L0) | |
555 | ENDIF | |
556 | IPB(L0)=2*L0-2 | |
557 | 240 CONTINUE | |
558 | C ********move all the qqbar pair to the front of | |
559 | C the list, except the first pair | |
560 | IP1=IP(2*LPQ-1,1) | |
561 | IP2=IP(2*LPQ-1,2) | |
562 | IP(2*LPQ-1,1)=IP(IPQ(1),1) | |
563 | IP(2*LPQ-1,2)=IP(IPQ(1),2) | |
564 | IP(IPQ(1),1)=IP1 | |
565 | IP(IPQ(1),2)=IP2 | |
566 | IF(IP2.GT.0) THEN | |
567 | IPQ(IP2)=IPQ(1) | |
568 | ELSE IF(IP2.LT.0) THEN | |
569 | IPB(-IP2)=IPQ(1) | |
570 | ENDIF | |
571 | IPQ(1)=2*LPQ-1 | |
572 | C ********move the first quark to the beginning of | |
573 | C the last string system | |
574 | IP1=IP(JPP,1) | |
575 | IP2=IP(JPP,2) | |
576 | IP(JPP,1)=IP(IPB(1),1) | |
577 | IP(JPP,2)=IP(IPB(1),2) | |
578 | IP(IPB(1),1)=IP1 | |
579 | IP(IPB(1),2)=IP2 | |
580 | IF(IP2.GT.0) THEN | |
581 | IPQ(IP2)=IPB(1) | |
582 | ELSE IF(IP2.LT.0) THEN | |
583 | IPB(-IP2)=IPB(1) | |
584 | ENDIF | |
585 | IPB(1)=JPP | |
586 | C ********move the first anti-quark to the end of the | |
587 | C last string system | |
588 | ENDIF | |
589 | IF(NSG.GE.MXSG) THEN | |
590 | JFLG=0 | |
591 | WRITE(6,*) 'number of jets forming single strings exceeds' | |
592 | WRITE(6,*) 'the common block size' | |
593 | RETURN | |
594 | ENDIF | |
595 | IF(JPP.GT.MXSJ) THEN | |
596 | JFLG=0 | |
597 | WRITE(6,*) 'number of partons per single jet system' | |
598 | WRITE(6,*) 'exceeds the common block size' | |
599 | RETURN | |
600 | ENDIF | |
601 | C ********check the bounds of common block size | |
602 | NSG=NSG+1 | |
603 | NJSG(NSG)=JPP | |
604 | IASG(NSG,1)=JP | |
605 | IASG(NSG,2)=JT | |
606 | IASG(NSG,3)=0 | |
607 | DO 300 I=1,JPP | |
608 | K1SG(NSG,I)=2 | |
609 | K2SG(NSG,I)=K(IP(I,1),2) | |
610 | IF(K2SG(NSG,I).LT.0) K1SG(NSG,I)=1 | |
611 | PXSG(NSG,I)=P(IP(I,1),1) | |
612 | PYSG(NSG,I)=P(IP(I,1),2) | |
613 | PZSG(NSG,I)=P(IP(I,1),3) | |
614 | PESG(NSG,I)=P(IP(I,1),4) | |
615 | PMSG(NSG,I)=P(IP(I,1),5) | |
616 | 300 CONTINUE | |
617 | K1SG(NSG,1)=2 | |
618 | K1SG(NSG,JPP)=1 | |
619 | C******* reset the energy-momentum of incoming particles ******** | |
620 | 900 PP(JP,1)=PXP | |
621 | PP(JP,2)=PYP | |
622 | PP(JP,3)=PZP | |
623 | PP(JP,4)=PEP | |
624 | PP(JP,5)=0.0 | |
625 | PT(JT,1)=PXT | |
626 | PT(JT,2)=PYT | |
627 | PT(JT,3)=PZT | |
628 | PT(JT,4)=PET | |
629 | PT(JT,5)=0.0 | |
630 | ||
631 | NFP(JP,6)=NFP(JP,6)+1 | |
632 | NFT(JT,6)=NFT(JT,6)+1 | |
633 | RETURN | |
634 | C | |
635 | 1000 JFLG=-1 | |
636 | IF(IHPR2(10).EQ.0) RETURN | |
637 | WRITE(6,*) 'Fatal HIJHRD error' | |
638 | WRITE(6,*) JP, ' proj E+,E-',EPP,EPM,' status',NFP(JP,5) | |
639 | WRITE(6,*) JT, ' targ E+,E_',ETP,ETM,' status',NFT(JT,5) | |
640 | RETURN | |
641 | END |