]> git.uio.no Git - u/mrichter/AliRoot.git/blame - HIJING/hipyset1_35/pyscat_hijing.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Modified file access mode
[u/mrichter/AliRoot.git] / HIJING / hipyset1_35 / pyscat_hijing.F
CommitLineData
e74335a4 1* $Id$
2
3C*********************************************************************
4
5 SUBROUTINE PYSCAT_HIJING
6
7C...Finds outgoing flavours and event type; sets up the kinematics
8C...and colour flow of the hard scattering.
9#include "lujets_hijing.inc"
10#include "ludat1_hijing.inc"
11#include "ludat2_hijing.inc"
12#include "ludat3_hijing.inc"
13#include "pysubs_hijing.inc"
14#include "pypars_hijing.inc"
15#include "pyint1_hijing.inc"
16#include "pyint2_hijing.inc"
17#include "pyint3_hijing.inc"
18#include "pyint4_hijing.inc"
19#include "pyint5_hijing.inc"
20 DIMENSION WDTP(0:40),WDTE(0:40,0:5),PMQ(2),Z(2),CTHE(2),PHI(2)
21
22C...Choice of subprocess, number of documentation lines.
23 ISUB=MINT(1)
24 IDOC=6+ISET(ISUB)
25 IF(ISUB.EQ.95) IDOC=8
26 MINT(3)=IDOC-6
27 IF(IDOC.GE.9) IDOC=IDOC+2
28 MINT(4)=IDOC
29 IPU1=MINT(84)+1
30 IPU2=MINT(84)+2
31 IPU3=MINT(84)+3
32 IPU4=MINT(84)+4
33 IPU5=MINT(84)+5
34 IPU6=MINT(84)+6
35
36C...Reset K, P and V vectors. Store incoming particles.
37 DO 100 JT=1,MSTP(126)+10
38 I=MINT(83)+JT
39 DO 100 J=1,5
40 K(I,J)=0
41 P(I,J)=0.
42 100 V(I,J)=0.
43 DO 110 JT=1,2
44 I=MINT(83)+JT
45 K(I,1)=21
46 K(I,2)=MINT(10+JT)
47 P(I,1)=0.
48 P(I,2)=0.
49 P(I,5)=VINT(2+JT)
50 P(I,3)=VINT(5)*(-1)**(JT+1)
51 110 P(I,4)=SQRT(P(I,3)**2+P(I,5)**2)
52 MINT(6)=2
53 KFRES=0
54
55C...Store incoming partons in their CM-frame.
56 SH=VINT(44)
57 SHR=SQRT(SH)
58 SHP=VINT(26)*VINT(2)
59 SHPR=SQRT(SHP)
60 SHUSER=SHR
61 IF(ISET(ISUB).GE.3) SHUSER=SHPR
62 DO 120 JT=1,2
63 I=MINT(84)+JT
64 K(I,1)=14
65 K(I,2)=MINT(14+JT)
66 K(I,3)=MINT(83)+2+JT
67 120 P(I,5)=ULMASS_HIJING(K(I,2))
68 IF(P(IPU1,5)+P(IPU2,5).GE.SHUSER) THEN
69 P(IPU1,5)=0.
70 P(IPU2,5)=0.
71 ENDIF
72 P(IPU1,4)=0.5*(SHUSER+(P(IPU1,5)**2-P(IPU2,5)**2)/SHUSER)
73 P(IPU1,3)=SQRT(MAX(0.,P(IPU1,4)**2-P(IPU1,5)**2))
74 P(IPU2,4)=SHUSER-P(IPU1,4)
75 P(IPU2,3)=-P(IPU1,3)
76
77C...Copy incoming partons to documentation lines.
78 DO 130 JT=1,2
79 I1=MINT(83)+4+JT
80 I2=MINT(84)+JT
81 K(I1,1)=21
82 K(I1,2)=K(I2,2)
83 K(I1,3)=I1-2
84 DO 130 J=1,5
85 130 P(I1,J)=P(I2,J)
86
87C...Choose new quark flavour for relevant annihilation graphs.
88 IF(ISUB.EQ.12.OR.ISUB.EQ.53) THEN
89 CALL PYWIDT_HIJING(21,SHR,WDTP,WDTE)
90 RKFL=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))*RLU_HIJING(0)
91 DO 140 I=1,2*MSTP(1)
92 KFLQ=I
93 RKFL=RKFL-(WDTE(I,1)+WDTE(I,2)+WDTE(I,4))
94 IF(RKFL.LE.0.) GOTO 150
95 140 CONTINUE
96 150 CONTINUE
97 ENDIF
98
99C...Final state flavours and colour flow: default values.
100 JS=1
101 MINT(21)=MINT(15)
102 MINT(22)=MINT(16)
103 MINT(23)=0
104 MINT(24)=0
105 KCC=20
106 KCS=ISIGN(1,MINT(15))
107
108 IF(ISUB.LE.10) THEN
109 IF(ISUB.EQ.1) THEN
110C...f + fb -> gamma*/Z0.
111 KFRES=23
112
113 ELSEIF(ISUB.EQ.2) THEN
114C...f + fb' -> W+/- .
115 KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
116 KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
117 KFRES=ISIGN(24,KCH1+KCH2)
118
119 ELSEIF(ISUB.EQ.3) THEN
120C...f + fb -> H0.
121 KFRES=25
122
123 ELSEIF(ISUB.EQ.4) THEN
124C...gamma + W+/- -> W+/-.
125
126 ELSEIF(ISUB.EQ.5) THEN
127C...Z0 + Z0 -> H0.
128 XH=SH/SHP
129 MINT(21)=MINT(15)
130 MINT(22)=MINT(16)
131 PMQ(1)=ULMASS_HIJING(MINT(21))
132 PMQ(2)=ULMASS_HIJING(MINT(22))
133 240 JT=INT(1.5+RLU_HIJING(0))
134 ZMIN=2.*PMQ(JT)/SHPR
135 ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT)))
136 ZMAX=MIN(1.-XH,ZMAX)
137 Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU_HIJING(0)
138 IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT.
139 & (1.-XH)**2/(4.*XH)*RLU_HIJING(0)) GOTO 240
140 SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP)
141 IF(SQC1.LT.1.E-8) GOTO 240
142 C1=SQRT(SQC1)
143 C2=1.+2.*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
144 CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU_HIJING(0)-1.)*C1))/C1
145 CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT)))
146 Z(3-JT)=1.-XH/(1.-Z(JT))
147 SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
148 IF(SQC1.LT.1.E-8) GOTO 240
149 C1=SQRT(SQC1)
150 C2=1.+2.*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
151 CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU_HIJING(0)-1.)*C1))/C1
152 CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT)))
153 PHIR=PARU(2)*RLU_HIJING(0)
154 CPHI=COS(PHIR)
155 ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI
156 Z1=2.-Z(JT)
157 Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP)
158 Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
159 Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
160 & PMQ(3-JT)**2/SHP))
161 ZMIN=2.*PMQ(3-JT)/SHPR
162 ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
163 ZMAX=MIN(1.-XH,ZMAX)
164 IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 240
165 KCC=22
166 KFRES=25
167
168 ELSEIF(ISUB.EQ.6) THEN
169C...Z0 + W+/- -> W+/-.
170
171 ELSEIF(ISUB.EQ.7) THEN
172C...W+ + W- -> Z0.
173
174 ELSEIF(ISUB.EQ.8) THEN
175C...W+ + W- -> H0.
176 XH=SH/SHP
177 250 DO 280 JT=1,2
178 I=MINT(14+JT)
179 IA=IABS(I)
180 IF(IA.LE.10) THEN
181 RVCKM=VINT(180+I)*RLU_HIJING(0)
182 DO 270 J=1,MSTP(1)
183 IB=2*J-1+MOD(IA,2)
184 IPM=(5-ISIGN(1,I))/2
185 IDC=J+MDCY(IA,2)+2
186 IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 270
187 MINT(20+JT)=ISIGN(IB,I)
188 RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
189 IF(RVCKM.LE.0.) GOTO 280
190 270 CONTINUE
191 ELSE
192 IB=2*((IA+1)/2)-1+MOD(IA,2)
193 MINT(20+JT)=ISIGN(IB,I)
194 ENDIF
195 280 PMQ(JT)=ULMASS_HIJING(MINT(20+JT))
196 JT=INT(1.5+RLU_HIJING(0))
197 ZMIN=2.*PMQ(JT)/SHPR
198 ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT)))
199 ZMAX=MIN(1.-XH,ZMAX)
200 Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU_HIJING(0)
201 IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT.
202 & (1.-XH)**2/(4.*XH)*RLU_HIJING(0)) GOTO 250
203 SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP)
204 IF(SQC1.LT.1.E-8) GOTO 250
205 C1=SQRT(SQC1)
206 C2=1.+2.*(PMAS(24,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
207 CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU_HIJING(0)-1.)*C1))/C1
208 CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT)))
209 Z(3-JT)=1.-XH/(1.-Z(JT))
210 SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
211 IF(SQC1.LT.1.E-8) GOTO 250
212 C1=SQRT(SQC1)
213 C2=1.+2.*(PMAS(24,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
214 CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU_HIJING(0)-1.)*C1))/C1
215 CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT)))
216 PHIR=PARU(2)*RLU_HIJING(0)
217 CPHI=COS(PHIR)
218 ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI
219 Z1=2.-Z(JT)
220 Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP)
221 Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
222 Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
223 & PMQ(3-JT)**2/SHP))
224 ZMIN=2.*PMQ(3-JT)/SHPR
225 ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
226 ZMAX=MIN(1.-XH,ZMAX)
227 IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 250
228 KCC=22
229 KFRES=25
230 ENDIF
231
232 ELSEIF(ISUB.LE.20) THEN
233 IF(ISUB.EQ.11) THEN
234C...f + f' -> f + f'; th = (p(f)-p(f))**2.
235 KCC=MINT(2)
236 IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2
237
238 ELSEIF(ISUB.EQ.12) THEN
239C...f + fb -> f' + fb'; th = (p(f)-p(f'))**2.
240 MINT(21)=ISIGN(KFLQ,MINT(15))
241 MINT(22)=-MINT(21)
242 KCC=4
243
244 ELSEIF(ISUB.EQ.13) THEN
245C...f + fb -> g + g; th arbitrary.
246 MINT(21)=21
247 MINT(22)=21
248 KCC=MINT(2)+4
249
250 ELSEIF(ISUB.EQ.14) THEN
251C...f + fb -> g + gam; th arbitrary.
252 IF(RLU_HIJING(0).GT.0.5) JS=2
253 MINT(20+JS)=21
254 MINT(23-JS)=22
255 KCC=17+JS
256
257 ELSEIF(ISUB.EQ.15) THEN
258C...f + fb -> g + Z0; th arbitrary.
259 IF(RLU_HIJING(0).GT.0.5) JS=2
260 MINT(20+JS)=21
261 MINT(23-JS)=23
262 KCC=17+JS
263
264 ELSEIF(ISUB.EQ.16) THEN
265C...f + fb' -> g + W+/-; th = (p(f)-p(W-))**2 or (p(fb')-p(W+))**2.
266 KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
267 KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
268 IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2
269 MINT(20+JS)=21
270 MINT(23-JS)=ISIGN(24,KCH1+KCH2)
271 KCC=17+JS
272
273 ELSEIF(ISUB.EQ.17) THEN
274C...f + fb -> g + H0; th arbitrary.
275 IF(RLU_HIJING(0).GT.0.5) JS=2
276 MINT(20+JS)=21
277 MINT(23-JS)=25
278 KCC=17+JS
279
280 ELSEIF(ISUB.EQ.18) THEN
281C...f + fb -> gamma + gamma; th arbitrary.
282 MINT(21)=22
283 MINT(22)=22
284
285 ELSEIF(ISUB.EQ.19) THEN
286C...f + fb -> gamma + Z0; th arbitrary.
287 IF(RLU_HIJING(0).GT.0.5) JS=2
288 MINT(20+JS)=22
289 MINT(23-JS)=23
290
291 ELSEIF(ISUB.EQ.20) THEN
292C...f + fb' -> gamma + W+/-; th = (p(f)-p(W-))**2 or (p(fb')-p(W+))**2.
293 KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
294 KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
295 IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2
296 MINT(20+JS)=22
297 MINT(23-JS)=ISIGN(24,KCH1+KCH2)
298 ENDIF
299
300 ELSEIF(ISUB.LE.30) THEN
301 IF(ISUB.EQ.21) THEN
302C...f + fb -> gamma + H0; th arbitrary.
303 IF(RLU_HIJING(0).GT.0.5) JS=2
304 MINT(20+JS)=22
305 MINT(23-JS)=25
306
307 ELSEIF(ISUB.EQ.22) THEN
308C...f + fb -> Z0 + Z0; th arbitrary.
309 MINT(21)=23
310 MINT(22)=23
311
312 ELSEIF(ISUB.EQ.23) THEN
313C...f + fb' -> Z0 + W+/-; th = (p(f)-p(W-))**2 or (p(fb')-p(W+))**2.
314 KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
315 KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
316 IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2
317 MINT(20+JS)=23
318 MINT(23-JS)=ISIGN(24,KCH1+KCH2)
319
320 ELSEIF(ISUB.EQ.24) THEN
321C...f + fb -> Z0 + H0; th arbitrary.
322 IF(RLU_HIJING(0).GT.0.5) JS=2
323 MINT(20+JS)=23
324 MINT(23-JS)=25
325
326 ELSEIF(ISUB.EQ.25) THEN
327C...f + fb -> W+ + W-; th = (p(f)-p(W-))**2.
328 MINT(21)=-ISIGN(24,MINT(15))
329 MINT(22)=-MINT(21)
330
331 ELSEIF(ISUB.EQ.26) THEN
332C...f + fb' -> W+/- + H0; th = (p(f)-p(W-))**2 or (p(fb')-p(W+))**2.
333 KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
334 KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
335 IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2
336 MINT(20+JS)=ISIGN(24,KCH1+KCH2)
337 MINT(23-JS)=25
338
339 ELSEIF(ISUB.EQ.27) THEN
340C...f + fb -> H0 + H0.
341
342 ELSEIF(ISUB.EQ.28) THEN
343C...f + g -> f + g; th = (p(f)-p(f))**2.
344 KCC=MINT(2)+6
345 IF(MINT(15).EQ.21) KCC=KCC+2
346 IF(MINT(15).NE.21) KCS=ISIGN(1,MINT(15))
347 IF(MINT(16).NE.21) KCS=ISIGN(1,MINT(16))
348
349 ELSEIF(ISUB.EQ.29) THEN
350C...f + g -> f + gamma; th = (p(f)-p(f))**2.
351 IF(MINT(15).EQ.21) JS=2
352 MINT(23-JS)=22
353 KCC=15+JS
354 KCS=ISIGN(1,MINT(14+JS))
355
356 ELSEIF(ISUB.EQ.30) THEN
357C...f + g -> f + Z0; th = (p(f)-p(f))**2.
358 IF(MINT(15).EQ.21) JS=2
359 MINT(23-JS)=23
360 KCC=15+JS
361 KCS=ISIGN(1,MINT(14+JS))
362 ENDIF
363
364 ELSEIF(ISUB.LE.40) THEN
365 IF(ISUB.EQ.31) THEN
366C...f + g -> f' + W+/-; th = (p(f)-p(f'))**2; choose flavour f'.
367 IF(MINT(15).EQ.21) JS=2
368 I=MINT(14+JS)
369 IA=IABS(I)
370 MINT(23-JS)=ISIGN(24,KCHG(IA,1)*I)
371 RVCKM=VINT(180+I)*RLU_HIJING(0)
372 DO 220 J=1,MSTP(1)
373 IB=2*J-1+MOD(IA,2)
374 IPM=(5-ISIGN(1,I))/2
375 IDC=J+MDCY(IA,2)+2
376 IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 220
377 MINT(20+JS)=ISIGN(IB,I)
378 RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
379 IF(RVCKM.LE.0.) GOTO 230
380 220 CONTINUE
381 230 KCC=15+JS
382 KCS=ISIGN(1,MINT(14+JS))
383
384 ELSEIF(ISUB.EQ.32) THEN
385C...f + g -> f + H0; th = (p(f)-p(f))**2.
386 IF(MINT(15).EQ.21) JS=2
387 MINT(23-JS)=25
388 KCC=15+JS
389 KCS=ISIGN(1,MINT(14+JS))
390
391 ELSEIF(ISUB.EQ.33) THEN
392C...f + gamma -> f + g.
393
394 ELSEIF(ISUB.EQ.34) THEN
395C...f + gamma -> f + gamma.
396
397 ELSEIF(ISUB.EQ.35) THEN
398C...f + gamma -> f + Z0.
399
400 ELSEIF(ISUB.EQ.36) THEN
401C...f + gamma -> f' + W+/-.
402
403 ELSEIF(ISUB.EQ.37) THEN
404C...f + gamma -> f + H0.
405
406 ELSEIF(ISUB.EQ.38) THEN
407C...f + Z0 -> f + g.
408
409 ELSEIF(ISUB.EQ.39) THEN
410C...f + Z0 -> f + gamma.
411
412 ELSEIF(ISUB.EQ.40) THEN
413C...f + Z0 -> f + Z0.
414 ENDIF
415
416 ELSEIF(ISUB.LE.50) THEN
417 IF(ISUB.EQ.41) THEN
418C...f + Z0 -> f' + W+/-.
419
420 ELSEIF(ISUB.EQ.42) THEN
421C...f + Z0 -> f + H0.
422
423 ELSEIF(ISUB.EQ.43) THEN
424C...f + W+/- -> f' + g.
425
426 ELSEIF(ISUB.EQ.44) THEN
427C...f + W+/- -> f' + gamma.
428
429 ELSEIF(ISUB.EQ.45) THEN
430C...f + W+/- -> f' + Z0.
431
432 ELSEIF(ISUB.EQ.46) THEN
433C...f + W+/- -> f' + W+/-.
434
435 ELSEIF(ISUB.EQ.47) THEN
436C...f + W+/- -> f' + H0.
437
438 ELSEIF(ISUB.EQ.48) THEN
439C...f + H0 -> f + g.
440
441 ELSEIF(ISUB.EQ.49) THEN
442C...f + H0 -> f + gamma.
443
444 ELSEIF(ISUB.EQ.50) THEN
445C...f + H0 -> f + Z0.
446 ENDIF
447
448 ELSEIF(ISUB.LE.60) THEN
449 IF(ISUB.EQ.51) THEN
450C...f + H0 -> f' + W+/-.
451
452 ELSEIF(ISUB.EQ.52) THEN
453C...f + H0 -> f + H0.
454
455 ELSEIF(ISUB.EQ.53) THEN
456C...g + g -> f + fb; th arbitrary.
457 KCS=(-1)**INT(1.5+RLU_HIJING(0))
458 MINT(21)=ISIGN(KFLQ,KCS)
459 MINT(22)=-MINT(21)
460 KCC=MINT(2)+10
461
462 ELSEIF(ISUB.EQ.54) THEN
463C...g + gamma -> f + fb.
464
465 ELSEIF(ISUB.EQ.55) THEN
466C...g + Z0 -> f + fb.
467
468 ELSEIF(ISUB.EQ.56) THEN
469C...g + W+/- -> f + fb'.
470
471 ELSEIF(ISUB.EQ.57) THEN
472C...g + H0 -> f + fb.
473
474 ELSEIF(ISUB.EQ.58) THEN
475C...gamma + gamma -> f + fb.
476
477 ELSEIF(ISUB.EQ.59) THEN
478C...gamma + Z0 -> f + fb.
479
480 ELSEIF(ISUB.EQ.60) THEN
481C...gamma + W+/- -> f + fb'.
482 ENDIF
483
484 ELSEIF(ISUB.LE.70) THEN
485 IF(ISUB.EQ.61) THEN
486C...gamma + H0 -> f + fb.
487
488 ELSEIF(ISUB.EQ.62) THEN
489C...Z0 + Z0 -> f + fb.
490
491 ELSEIF(ISUB.EQ.63) THEN
492C...Z0 + W+/- -> f + fb'.
493
494 ELSEIF(ISUB.EQ.64) THEN
495C...Z0 + H0 -> f + fb.
496
497 ELSEIF(ISUB.EQ.65) THEN
498C...W+ + W- -> f + fb.
499
500 ELSEIF(ISUB.EQ.66) THEN
501C...W+/- + H0 -> f + fb'.
502
503 ELSEIF(ISUB.EQ.67) THEN
504C...H0 + H0 -> f + fb.
505
506 ELSEIF(ISUB.EQ.68) THEN
507C...g + g -> g + g; th arbitrary.
508 KCC=MINT(2)+12
509 KCS=(-1)**INT(1.5+RLU_HIJING(0))
510
511 ELSEIF(ISUB.EQ.69) THEN
512C...gamma + gamma -> W+ + W-.
513
514 ELSEIF(ISUB.EQ.70) THEN
515C...gamma + W+/- -> gamma + W+/-
516 ENDIF
517
518 ELSEIF(ISUB.LE.80) THEN
519 IF(ISUB.EQ.71.OR.ISUB.EQ.72) THEN
520C...Z0 + Z0 -> Z0 + Z0; Z0 + Z0 -> W+ + W-.
521 XH=SH/SHP
522 MINT(21)=MINT(15)
523 MINT(22)=MINT(16)
524 PMQ(1)=ULMASS_HIJING(MINT(21))
525 PMQ(2)=ULMASS_HIJING(MINT(22))
526 290 JT=INT(1.5+RLU_HIJING(0))
527 ZMIN=2.*PMQ(JT)/SHPR
528 ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT)))
529 ZMAX=MIN(1.-XH,ZMAX)
530 Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU_HIJING(0)
531 IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT.
532 & (1.-XH)**2/(4.*XH)*RLU_HIJING(0)) GOTO 290
533 SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP)
534 IF(SQC1.LT.1.E-8) GOTO 290
535 C1=SQRT(SQC1)
536 C2=1.+2.*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
537 CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU_HIJING(0)-1.)*C1))/C1
538 CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT)))
539 Z(3-JT)=1.-XH/(1.-Z(JT))
540 SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
541 IF(SQC1.LT.1.E-8) GOTO 290
542 C1=SQRT(SQC1)
543 C2=1.+2.*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
544 CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU_HIJING(0)-1.)*C1))/C1
545 CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT)))
546 PHIR=PARU(2)*RLU_HIJING(0)
547 CPHI=COS(PHIR)
548 ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI
549 Z1=2.-Z(JT)
550 Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP)
551 Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
552 Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
553 & PMQ(3-JT)**2/SHP))
554 ZMIN=2.*PMQ(3-JT)/SHPR
555 ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
556 ZMAX=MIN(1.-XH,ZMAX)
557 IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 290
558 KCC=22
559
560 ELSEIF(ISUB.EQ.73) THEN
561C...Z0 + W+/- -> Z0 + W+/-.
562 XH=SH/SHP
563 300 JT=INT(1.5+RLU_HIJING(0))
564 I=MINT(14+JT)
565 IA=IABS(I)
566 IF(IA.LE.10) THEN
567 RVCKM=VINT(180+I)*RLU_HIJING(0)
568 DO 320 J=1,MSTP(1)
569 IB=2*J-1+MOD(IA,2)
570 IPM=(5-ISIGN(1,I))/2
571 IDC=J+MDCY(IA,2)+2
572 IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 320
573 MINT(20+JT)=ISIGN(IB,I)
574 RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
575 IF(RVCKM.LE.0.) GOTO 330
576 320 CONTINUE
577 ELSE
578 IB=2*((IA+1)/2)-1+MOD(IA,2)
579 MINT(20+JT)=ISIGN(IB,I)
580 ENDIF
581 330 PMQ(JT)=ULMASS_HIJING(MINT(20+JT))
582 MINT(23-JT)=MINT(17-JT)
583 PMQ(3-JT)=ULMASS_HIJING(MINT(23-JT))
584 JT=INT(1.5+RLU_HIJING(0))
585 ZMIN=2.*PMQ(JT)/SHPR
586 ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT)))
587 ZMAX=MIN(1.-XH,ZMAX)
588 Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU_HIJING(0)
589 IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT.
590 & (1.-XH)**2/(4.*XH)*RLU_HIJING(0)) GOTO 300
591 SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP)
592 IF(SQC1.LT.1.E-8) GOTO 300
593 C1=SQRT(SQC1)
594 C2=1.+2.*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
595 CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU_HIJING(0)-1.)*C1))/C1
596 CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT)))
597 Z(3-JT)=1.-XH/(1.-Z(JT))
598 SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
599 IF(SQC1.LT.1.E-8) GOTO 300
600 C1=SQRT(SQC1)
601 C2=1.+2.*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
602 CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU_HIJING(0)-1.)*C1))/C1
603 CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT)))
604 PHIR=PARU(2)*RLU_HIJING(0)
605 CPHI=COS(PHIR)
606 ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI
607 Z1=2.-Z(JT)
608 Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP)
609 Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
610 Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
611 & PMQ(3-JT)**2/SHP))
612 ZMIN=2.*PMQ(3-JT)/SHPR
613 ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
614 ZMAX=MIN(1.-XH,ZMAX)
615 IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 300
616 KCC=22
617
618 ELSEIF(ISUB.EQ.74) THEN
619C...Z0 + H0 -> Z0 + H0.
620
621 ELSEIF(ISUB.EQ.75) THEN
622C...W+ + W- -> gamma + gamma.
623
624 ELSEIF(ISUB.EQ.76.OR.ISUB.EQ.77) THEN
625C...W+ + W- -> Z0 + Z0; W+ + W- -> W+ + W-.
626 XH=SH/SHP
627 340 DO 370 JT=1,2
628 I=MINT(14+JT)
629 IA=IABS(I)
630 IF(IA.LE.10) THEN
631 RVCKM=VINT(180+I)*RLU_HIJING(0)
632 DO 360 J=1,MSTP(1)
633 IB=2*J-1+MOD(IA,2)
634 IPM=(5-ISIGN(1,I))/2
635 IDC=J+MDCY(IA,2)+2
636 IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 360
637 MINT(20+JT)=ISIGN(IB,I)
638 RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
639 IF(RVCKM.LE.0.) GOTO 370
640 360 CONTINUE
641 ELSE
642 IB=2*((IA+1)/2)-1+MOD(IA,2)
643 MINT(20+JT)=ISIGN(IB,I)
644 ENDIF
645 370 PMQ(JT)=ULMASS_HIJING(MINT(20+JT))
646 JT=INT(1.5+RLU_HIJING(0))
647 ZMIN=2.*PMQ(JT)/SHPR
648 ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT)))
649 ZMAX=MIN(1.-XH,ZMAX)
650 Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU_HIJING(0)
651 IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT.
652 & (1.-XH)**2/(4.*XH)*RLU_HIJING(0)) GOTO 340
653 SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP)
654 IF(SQC1.LT.1.E-8) GOTO 340
655 C1=SQRT(SQC1)
656 C2=1.+2.*(PMAS(24,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
657 CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU_HIJING(0)-1.)*C1))/C1
658 CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT)))
659 Z(3-JT)=1.-XH/(1.-Z(JT))
660 SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
661 IF(SQC1.LT.1.E-8) GOTO 340
662 C1=SQRT(SQC1)
663 C2=1.+2.*(PMAS(24,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
664 CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU_HIJING(0)-1.)*C1))/C1
665 CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT)))
666 PHIR=PARU(2)*RLU_HIJING(0)
667 CPHI=COS(PHIR)
668 ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI
669 Z1=2.-Z(JT)
670 Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP)
671 Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
672 Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
673 & PMQ(3-JT)**2/SHP))
674 ZMIN=2.*PMQ(3-JT)/SHPR
675 ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
676 ZMAX=MIN(1.-XH,ZMAX)
677 IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 340
678 KCC=22
679
680 ELSEIF(ISUB.EQ.78) THEN
681C...W+/- + H0 -> W+/- + H0.
682
683 ELSEIF(ISUB.EQ.79) THEN
684C...H0 + H0 -> H0 + H0.
685 ENDIF
686
687 ELSEIF(ISUB.LE.90) THEN
688 IF(ISUB.EQ.81) THEN
689C...q + qb -> Q' + Qb'; th = (p(q)-p(q'))**2.
690 MINT(21)=ISIGN(MINT(46),MINT(15))
691 MINT(22)=-MINT(21)
692 KCC=4
693
694 ELSEIF(ISUB.EQ.82) THEN
695C...g + g -> Q + Qb; th arbitrary.
696 KCS=(-1)**INT(1.5+RLU_HIJING(0))
697 MINT(21)=ISIGN(MINT(46),KCS)
698 MINT(22)=-MINT(21)
699 KCC=MINT(2)+10
700 ENDIF
701
702 ELSEIF(ISUB.LE.100) THEN
703 IF(ISUB.EQ.95) THEN
704C...Low-pT ( = energyless g + g -> g + g).
705 KCC=MINT(2)+12
706 KCS=(-1)**INT(1.5+RLU_HIJING(0))
707
708 ELSEIF(ISUB.EQ.96) THEN
709C...Multiple interactions (should be reassigned to QCD process).
710 ENDIF
711
712 ELSEIF(ISUB.LE.110) THEN
713 IF(ISUB.EQ.101) THEN
714C...g + g -> gamma*/Z0.
715 KCC=21
716 KFRES=22
717
718 ELSEIF(ISUB.EQ.102) THEN
719C...g + g -> H0.
720 KCC=21
721 KFRES=25
722 ENDIF
723
724 ELSEIF(ISUB.LE.120) THEN
725 IF(ISUB.EQ.111) THEN
726C...f + fb -> g + H0; th arbitrary.
727 IF(RLU_HIJING(0).GT.0.5) JS=2
728 MINT(20+JS)=21
729 MINT(23-JS)=25
730 KCC=17+JS
731
732 ELSEIF(ISUB.EQ.112) THEN
733C...f + g -> f + H0; th = (p(f) - p(f))**2.
734 IF(MINT(15).EQ.21) JS=2
735 MINT(23-JS)=25
736 KCC=15+JS
737 KCS=ISIGN(1,MINT(14+JS))
738
739 ELSEIF(ISUB.EQ.113) THEN
740C...g + g -> g + H0; th arbitrary.
741 IF(RLU_HIJING(0).GT.0.5) JS=2
742 MINT(23-JS)=25
743 KCC=22+JS
744 KCS=(-1)**INT(1.5+RLU_HIJING(0))
745
746 ELSEIF(ISUB.EQ.114) THEN
747C...g + g -> gamma + gamma; th arbitrary.
748 IF(RLU_HIJING(0).GT.0.5) JS=2
749 MINT(21)=22
750 MINT(22)=22
751 KCC=21
752
753 ELSEIF(ISUB.EQ.115) THEN
754C...g + g -> gamma + Z0.
755
756 ELSEIF(ISUB.EQ.116) THEN
757C...g + g -> Z0 + Z0.
758
759 ELSEIF(ISUB.EQ.117) THEN
760C...g + g -> W+ + W-.
761 ENDIF
762
763 ELSEIF(ISUB.LE.140) THEN
764 IF(ISUB.EQ.121) THEN
765C...g + g -> f + fb + H0.
766 ENDIF
767
768 ELSEIF(ISUB.LE.160) THEN
769 IF(ISUB.EQ.141) THEN
770C...f + fb -> gamma*/Z0/Z'0.
771 KFRES=32
772
773 ELSEIF(ISUB.EQ.142) THEN
774C...f + fb' -> H+/-.
775 KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
776 KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
777 KFRES=ISIGN(37,KCH1+KCH2)
778
779 ELSEIF(ISUB.EQ.143) THEN
780C...f + fb' -> R.
781 KFRES=ISIGN(40,MINT(15)+MINT(16))
782 ENDIF
783
784 ELSE
785 IF(ISUB.EQ.161) THEN
786C...g + f -> H+/- + f'; th = (p(f)-p(f))**2.
787 IF(MINT(16).EQ.21) JS=2
788 IA=IABS(MINT(17-JS))
789 MINT(20+JS)=ISIGN(37,KCHG(IA,1)*MINT(17-JS))
790 JA=IA+MOD(IA,2)-MOD(IA+1,2)
791 MINT(23-JS)=ISIGN(JA,MINT(17-JS))
792 KCC=18-JS
793 IF(MINT(15).NE.21) KCS=ISIGN(1,MINT(15))
794 IF(MINT(16).NE.21) KCS=ISIGN(1,MINT(16))
795 ENDIF
796 ENDIF
797
798 IF(IDOC.EQ.7) THEN
799C...Resonance not decaying: store colour connection indices.
800 I=MINT(83)+7
801 K(IPU3,1)=1
802 K(IPU3,2)=KFRES
803 K(IPU3,3)=I
804 P(IPU3,4)=SHUSER
805 P(IPU3,5)=SHUSER
806 K(IPU1,4)=IPU2
807 K(IPU1,5)=IPU2
808 K(IPU2,4)=IPU1
809 K(IPU2,5)=IPU1
810 K(I,1)=21
811 K(I,2)=KFRES
812 P(I,4)=SHUSER
813 P(I,5)=SHUSER
814 N=IPU3
815 MINT(21)=KFRES
816 MINT(22)=0
817
818 ELSEIF(IDOC.EQ.8) THEN
819C...2 -> 2 processes: store outgoing partons in their CM-frame.
820 DO 390 JT=1,2
821 I=MINT(84)+2+JT
822 K(I,1)=1
823 IF(IABS(MINT(20+JT)).LE.10.OR.MINT(20+JT).EQ.21) K(I,1)=3
824 K(I,2)=MINT(20+JT)
825 K(I,3)=MINT(83)+IDOC+JT-2
826 IF(IABS(K(I,2)).LE.10.OR.K(I,2).EQ.21) THEN
827 P(I,5)=ULMASS_HIJING(K(I,2))
828 ELSE
829 P(I,5)=SQRT(VINT(63+MOD(JS+JT,2)))
830 ENDIF
831 390 CONTINUE
832 IF(P(IPU3,5)+P(IPU4,5).GE.SHR) THEN
833 KFA1=IABS(MINT(21))
834 KFA2=IABS(MINT(22))
835 IF((KFA1.GT.3.AND.KFA1.NE.21).OR.(KFA2.GT.3.AND.KFA2.NE.21))
836 & THEN
837 MINT(51)=1
838 RETURN
839 ENDIF
840 P(IPU3,5)=0.
841 P(IPU4,5)=0.
842 ENDIF
843 P(IPU3,4)=0.5*(SHR+(P(IPU3,5)**2-P(IPU4,5)**2)/SHR)
844 P(IPU3,3)=SQRT(MAX(0.,P(IPU3,4)**2-P(IPU3,5)**2))
845 P(IPU4,4)=SHR-P(IPU3,4)
846 P(IPU4,3)=-P(IPU3,3)
847 N=IPU4
848 MINT(7)=MINT(83)+7
849 MINT(8)=MINT(83)+8
850
851C...Rotate outgoing partons using cos(theta)=(th-uh)/lam(sh,sqm3,sqm4).
852 CALL LUDBRB_HIJING(IPU3,IPU4,ACOS(VINT(23)),VINT(24),0D0,0D0,0D0
853 $ )
854
855 ELSEIF(IDOC.EQ.9) THEN
856C'''2 -> 3 processes:
857
858 ELSEIF(IDOC.EQ.11) THEN
859C...Z0 + Z0 -> H0, W+ + W- -> H0: store Higgs and outgoing partons.
860 PHI(1)=PARU(2)*RLU_HIJING(0)
861 PHI(2)=PHI(1)-PHIR
862 DO 400 JT=1,2
863 I=MINT(84)+2+JT
864 K(I,1)=1
865 IF(IABS(MINT(20+JT)).LE.10.OR.MINT(20+JT).EQ.21) K(I,1)=3
866 K(I,2)=MINT(20+JT)
867 K(I,3)=MINT(83)+IDOC+JT-2
868 P(I,5)=ULMASS_HIJING(K(I,2))
869 IF(0.5*SHPR*Z(JT).LE.P(I,5)) P(I,5)=0.
870 PABS=SQRT(MAX(0.,(0.5*SHPR*Z(JT))**2-P(I,5)**2))
871 PTABS=PABS*SQRT(MAX(0.,1.-CTHE(JT)**2))
872 P(I,1)=PTABS*COS(PHI(JT))
873 P(I,2)=PTABS*SIN(PHI(JT))
874 P(I,3)=PABS*CTHE(JT)*(-1)**(JT+1)
875 P(I,4)=0.5*SHPR*Z(JT)
876 IZW=MINT(83)+6+JT
877 K(IZW,1)=21
878 K(IZW,2)=23
879 IF(ISUB.EQ.8) K(IZW,2)=ISIGN(24,LUCHGE_HIJING(MINT(14+JT)))
880 K(IZW,3)=IZW-2
881 P(IZW,1)=-P(I,1)
882 P(IZW,2)=-P(I,2)
883 P(IZW,3)=(0.5*SHPR-PABS*CTHE(JT))*(-1)**(JT+1)
884 P(IZW,4)=0.5*SHPR*(1.-Z(JT))
885 400 P(IZW,5)=-SQRT(MAX(0.,P(IZW,3)**2+PTABS**2-P(IZW,4)**2))
886 I=MINT(83)+9
887 K(IPU5,1)=1
888 K(IPU5,2)=KFRES
889 K(IPU5,3)=I
890 P(IPU5,5)=SHR
891 P(IPU5,1)=-P(IPU3,1)-P(IPU4,1)
892 P(IPU5,2)=-P(IPU3,2)-P(IPU4,2)
893 P(IPU5,3)=-P(IPU3,3)-P(IPU4,3)
894 P(IPU5,4)=SHPR-P(IPU3,4)-P(IPU4,4)
895 K(I,1)=21
896 K(I,2)=KFRES
897 DO 410 J=1,5
898 410 P(I,J)=P(IPU5,J)
899 N=IPU5
900 MINT(23)=KFRES
901
902 ELSEIF(IDOC.EQ.12) THEN
903C...Z0 and W+/- scattering: store bosons and outgoing partons.
904 PHI(1)=PARU(2)*RLU_HIJING(0)
905 PHI(2)=PHI(1)-PHIR
906 DO 420 JT=1,2
907 I=MINT(84)+2+JT
908 K(I,1)=1
909 IF(IABS(MINT(20+JT)).LE.10.OR.MINT(20+JT).EQ.21) K(I,1)=3
910 K(I,2)=MINT(20+JT)
911 K(I,3)=MINT(83)+IDOC+JT-2
912 P(I,5)=ULMASS_HIJING(K(I,2))
913 IF(0.5*SHPR*Z(JT).LE.P(I,5)) P(I,5)=0.
914 PABS=SQRT(MAX(0.,(0.5*SHPR*Z(JT))**2-P(I,5)**2))
915 PTABS=PABS*SQRT(MAX(0.,1.-CTHE(JT)**2))
916 P(I,1)=PTABS*COS(PHI(JT))
917 P(I,2)=PTABS*SIN(PHI(JT))
918 P(I,3)=PABS*CTHE(JT)*(-1)**(JT+1)
919 P(I,4)=0.5*SHPR*Z(JT)
920 IZW=MINT(83)+6+JT
921 K(IZW,1)=21
922 IF(MINT(14+JT).EQ.MINT(20+JT)) THEN
923 K(IZW,2)=23
924 ELSE
925 K(IZW,2)=ISIGN(24,LUCHGE_HIJING(MINT(14+JT))
926 $ -LUCHGE_HIJING(MINT(20+JT)))
927 ENDIF
928 K(IZW,3)=IZW-2
929 P(IZW,1)=-P(I,1)
930 P(IZW,2)=-P(I,2)
931 P(IZW,3)=(0.5*SHPR-PABS*CTHE(JT))*(-1)**(JT+1)
932 P(IZW,4)=0.5*SHPR*(1.-Z(JT))
933 P(IZW,5)=-SQRT(MAX(0.,P(IZW,3)**2+PTABS**2-P(IZW,4)**2))
934 IPU=MINT(84)+4+JT
935 K(IPU,1)=3
936 K(IPU,2)=KFPR(ISUB,JT)
937 K(IPU,3)=MINT(83)+8+JT
938 IF(IABS(K(IPU,2)).LE.10.OR.K(IPU,2).EQ.21) THEN
939 P(IPU,5)=ULMASS_HIJING(K(IPU,2))
940 ELSE
941 P(IPU,5)=SQRT(VINT(63+MOD(JS+JT,2)))
942 ENDIF
943 MINT(22+JT)=K(IZW,2)
944 420 CONTINUE
945 IF(ISUB.EQ.72) K(MINT(84)+4+INT(1.5+RLU_HIJING(0)),2)=-24
946C...Find rotation and boost for hard scattering subsystem.
947 I1=MINT(83)+7
948 I2=MINT(83)+8
949 BEXCM=(P(I1,1)+P(I2,1))/(P(I1,4)+P(I2,4))
950 BEYCM=(P(I1,2)+P(I2,2))/(P(I1,4)+P(I2,4))
951 BEZCM=(P(I1,3)+P(I2,3))/(P(I1,4)+P(I2,4))
952 GAMCM=(P(I1,4)+P(I2,4))/SHR
953 BEPCM=BEXCM*P(I1,1)+BEYCM*P(I1,2)+BEZCM*P(I1,3)
954 PX=P(I1,1)+GAMCM*(GAMCM/(1.+GAMCM)*BEPCM-P(I1,4))*BEXCM
955 PY=P(I1,2)+GAMCM*(GAMCM/(1.+GAMCM)*BEPCM-P(I1,4))*BEYCM
956 PZ=P(I1,3)+GAMCM*(GAMCM/(1.+GAMCM)*BEPCM-P(I1,4))*BEZCM
957 THECM=ULANGL_HIJING(PZ,SQRT(PX**2+PY**2))
958 PHICM=ULANGL_HIJING(PX,PY)
959C...Store hard scattering subsystem. Rotate and boost it.
960 SQLAM=(SH-P(IPU5,5)**2-P(IPU6,5)**2)**2-4.*P(IPU5,5)**2*
961 & P(IPU6,5)**2
962 PABS=SQRT(MAX(0.,SQLAM/(4.*SH)))
963 CTHWZ=VINT(23)
964 STHWZ=SQRT(MAX(0.,1.-CTHWZ**2))
965 PHIWZ=VINT(24)-PHICM
966 P(IPU5,1)=PABS*STHWZ*COS(PHIWZ)
967 P(IPU5,2)=PABS*STHWZ*SIN(PHIWZ)
968 P(IPU5,3)=PABS*CTHWZ
969 P(IPU5,4)=SQRT(PABS**2+P(IPU5,5)**2)
970 P(IPU6,1)=-P(IPU5,1)
971 P(IPU6,2)=-P(IPU5,2)
972 P(IPU6,3)=-P(IPU5,3)
973 P(IPU6,4)=SQRT(PABS**2+P(IPU6,5)**2)
974 CALL LUDBRB_HIJING(IPU5,IPU6,THECM,PHICM,DBLE(BEXCM),DBLE(BEYCM)
975 $ ,DBLE(BEZCM))
976 DO 430 JT=1,2
977 I1=MINT(83)+8+JT
978 I2=MINT(84)+4+JT
979 K(I1,1)=21
980 K(I1,2)=K(I2,2)
981 DO 430 J=1,5
982 430 P(I1,J)=P(I2,J)
983 N=IPU6
984 MINT(7)=MINT(83)+9
985 MINT(8)=MINT(83)+10
986 ENDIF
987
988 IF(IDOC.GE.8) THEN
989C...Store colour connection indices.
990 DO 440 J=1,2
991 JC=J
992 IF(KCS.EQ.-1) JC=3-J
993 IF(ICOL(KCC,1,JC).NE.0.AND.K(IPU1,1).EQ.14) K(IPU1,J+3)=
994 & K(IPU1,J+3)+MINT(84)+ICOL(KCC,1,JC)
995 IF(ICOL(KCC,2,JC).NE.0.AND.K(IPU2,1).EQ.14) K(IPU2,J+3)=
996 & K(IPU2,J+3)+MINT(84)+ICOL(KCC,2,JC)
997 IF(ICOL(KCC,3,JC).NE.0.AND.K(IPU3,1).EQ.3) K(IPU3,J+3)=
998 & MSTU(5)*(MINT(84)+ICOL(KCC,3,JC))
999 440 IF(ICOL(KCC,4,JC).NE.0.AND.K(IPU4,1).EQ.3) K(IPU4,J+3)=
1000 & MSTU(5)*(MINT(84)+ICOL(KCC,4,JC))
1001
1002C...Copy outgoing partons to documentation lines.
1003 DO 450 I=1,2
1004 I1=MINT(83)+IDOC-2+I
1005 I2=MINT(84)+2+I
1006 K(I1,1)=21
1007 K(I1,2)=K(I2,2)
1008 IF(IDOC.LE.9) K(I1,3)=0
1009 IF(IDOC.GE.11) K(I1,3)=MINT(83)+2+I
1010 DO 450 J=1,5
1011 450 P(I1,J)=P(I2,J)
1012 ENDIF
1013 MINT(52)=N
1014
1015C...Low-pT events: remove gluons used for string drawing purposes.
1016 IF(ISUB.EQ.95) THEN
1017 K(IPU3,1)=K(IPU3,1)+10
1018 K(IPU4,1)=K(IPU4,1)+10
1019 DO 460 J=41,66
1020 460 VINT(J)=0.
1021 DO 470 I=MINT(83)+5,MINT(83)+8
1022 DO 470 J=1,5
1023 470 P(I,J)=0.
1024 ENDIF
1025
1026 RETURN
1027 END