]> git.uio.no Git - u/mrichter/AliRoot.git/blame - PYTHIA/pythia/pyscat.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / PYTHIA / pythia / pyscat.F
CommitLineData
fe4da5cc 1
2C*********************************************************************
3
4 SUBROUTINE PYSCAT
5
6C...Finds outgoing flavours and event type; sets up the kinematics
7C...and colour flow of the hard scattering.
8 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
9 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
10 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
11 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
12 COMMON/PYSUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
13 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
14 COMMON/PYINT1/MINT(400),VINT(400)
15 COMMON/PYINT2/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2)
16 COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000)
17 COMMON/PYINT4/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3)
18 COMMON/PYINT5/NGEN(0:200,3),XSEC(0:200,3)
19 COMMON/PYUPPR/NUP,KUP(20,7),PUP(20,5),NFUP,IFUP(10,2),Q2UP(0:10)
20 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/
21 SAVE /PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/,
22 &/PYINT5/,/PYUPPR/
23 DIMENSION WDTP(0:40),WDTE(0:40,0:5),PMQ(2),Z(2),CTHE(2),PHI(2),
24 &KUPPO(20),VINTSV(41:66)
25 SAVE VINTSV
26
27C...Read out process.
28 ISUB=MINT(1)
29 ISUBSV=ISUB
30
31C...Restore information for low-pT processes.
32 IF(ISUB.EQ.95.AND.MINT(57).GE.1) THEN
33 DO 100 J=41,66
34 100 VINT(J)=VINTSV(J)
35 ENDIF
36
37C...Convert H' or A process into equivalent H one.
38 IHIGG=1
39 KFHIGG=25
40 IF((ISUB.GE.151.AND.ISUB.LE.160).OR.(ISUB.GE.171.AND.
41 &ISUB.LE.190)) THEN
42 IHIGG=2
43 IF(MOD(ISUB-1,10).GE.5) IHIGG=3
44 KFHIGG=33+IHIGG
45 IF(ISUB.EQ.151.OR.ISUB.EQ.156) ISUB=3
46 IF(ISUB.EQ.152.OR.ISUB.EQ.157) ISUB=102
47 IF(ISUB.EQ.153.OR.ISUB.EQ.158) ISUB=103
48 IF(ISUB.EQ.171.OR.ISUB.EQ.176) ISUB=24
49 IF(ISUB.EQ.172.OR.ISUB.EQ.177) ISUB=26
50 IF(ISUB.EQ.173.OR.ISUB.EQ.178) ISUB=123
51 IF(ISUB.EQ.174.OR.ISUB.EQ.179) ISUB=124
52 IF(ISUB.EQ.181.OR.ISUB.EQ.186) ISUB=121
53 IF(ISUB.EQ.182.OR.ISUB.EQ.187) ISUB=122
54 ENDIF
55
56C...Choice of subprocess, number of documentation lines.
57 IDOC=6+ISET(ISUB)
58 IF(ISUB.EQ.95) IDOC=8
59 IF(ISET(ISUB).EQ.5.OR.ISET(ISUB).EQ.6) IDOC=9
60 IF(ISET(ISUB).EQ.11) IDOC=4+NUP
61 MINT(3)=IDOC-6
62 IF(IDOC.GE.9.AND.ISET(ISUB).LE.4) IDOC=IDOC+2
63 MINT(4)=IDOC
64 IPU1=MINT(84)+1
65 IPU2=MINT(84)+2
66 IPU3=MINT(84)+3
67 IPU4=MINT(84)+4
68 IPU5=MINT(84)+5
69 IPU6=MINT(84)+6
70
71C...Reset K, P and V vectors. Store incoming particles.
72 DO 120 JT=1,MSTP(126)+20
73 I=MINT(83)+JT
74 DO 110 J=1,5
75 K(I,J)=0
76 P(I,J)=0.
77 V(I,J)=0.
78 110 CONTINUE
79 120 CONTINUE
80 DO 140 JT=1,2
81 I=MINT(83)+JT
82 K(I,1)=21
83 K(I,2)=MINT(10+JT)
84 DO 130 J=1,5
85 P(I,J)=VINT(285+5*JT+J)
86 130 CONTINUE
87 140 CONTINUE
88 MINT(6)=2
89 KFRES=0
90
91C...Store incoming partons in their CM-frame.
92 SH=VINT(44)
93 SHR=SQRT(SH)
94 SHP=VINT(26)*VINT(2)
95 SHPR=SQRT(SHP)
96 SHUSER=SHR
97 IF(ISET(ISUB).GE.3.AND.ISET(ISUB).LE.5) SHUSER=SHPR
98 DO 150 JT=1,2
99 I=MINT(84)+JT
100 K(I,1)=14
101 K(I,2)=MINT(14+JT)
102 K(I,3)=MINT(83)+2+JT
103 P(I,3)=0.5*SHUSER*(-1.)**(JT-1)
104 P(I,4)=0.5*SHUSER
105 150 CONTINUE
106
107C...Copy incoming partons to documentation lines.
108 DO 170 JT=1,2
109 I1=MINT(83)+4+JT
110 I2=MINT(84)+JT
111 K(I1,1)=21
112 K(I1,2)=K(I2,2)
113 K(I1,3)=I1-2
114 DO 160 J=1,5
115 P(I1,J)=P(I2,J)
116 160 CONTINUE
117 170 CONTINUE
118
119C...Choose new quark/lepton flavour for relevant annihilation graphs.
120 IF(ISUB.EQ.12.OR.ISUB.EQ.53.OR.ISUB.EQ.54.OR.ISUB.EQ.58) THEN
121 IGLGA=21
122 IF(ISUB.EQ.58) IGLGA=22
123 CALL PYWIDT(IGLGA,SH,WDTP,WDTE)
124 180 RKFL=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))*RLU(0)
125 DO 190 I=1,MDCY(IGLGA,3)
126 KFLF=KFDP(I+MDCY(IGLGA,2)-1,1)
127 RKFL=RKFL-(WDTE(I,1)+WDTE(I,2)+WDTE(I,4))
128 IF(RKFL.LE.0.) GOTO 200
129 190 CONTINUE
130 200 CONTINUE
131 IF(ISUB.EQ.12.AND.MSTP(5).EQ.1.AND.IABS(MINT(15)).LE.2.AND.
132 & IABS(KFLF).GE.3) THEN
133 FACQQB=VINT(58)**2*4./9.*(VINT(45)**2+VINT(46)**2)/
134 & VINT(44)**2
135 FACCIB=VINT(46)**2/PARU(155)**4
136 IF(FACQQB/(FACQQB+FACCIB).LT.RLU(0)) GOTO 180
137 ELSEIF(ISUB.EQ.54) THEN
138 IF((KCHG(IABS(KFLF),1)/2.)**2.LT.RLU(0)) GOTO 180
139 ELSEIF(ISUB.EQ.58) THEN
140 IF((KCHG(IABS(KFLF),1)/3.)**2.LT.RLU(0)) GOTO 180
141 ENDIF
142 ENDIF
143
144C...Final state flavours and colour flow: default values.
145 JS=1
146 MINT(21)=MINT(15)
147 MINT(22)=MINT(16)
148 MINT(23)=0
149 MINT(24)=0
150 KCC=20
151 KCS=ISIGN(1,MINT(15))
152
153 IF(ISET(ISUB).EQ.11) THEN
154C...User-defined processes: find products.
155 IRUP=0
156 DO 210 IUP=3,NUP
157 IF(KUP(IUP,1).NE.1) THEN
158 ELSEIF(IRUP.LE.5) THEN
159 IRUP=IRUP+1
160 MINT(20+IRUP)=KUP(IUP,2)
161 ENDIF
162 210 CONTINUE
163
164 ELSEIF(ISUB.LE.10) THEN
165 IF(ISUB.EQ.1) THEN
166C...f + f~ -> gamma*/Z0.
167 KFRES=23
168
169 ELSEIF(ISUB.EQ.2) THEN
170C...f + f~' -> W+/- .
171 KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
172 KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
173 KFRES=ISIGN(24,KCH1+KCH2)
174
175 ELSEIF(ISUB.EQ.3) THEN
176C...f + f~ -> H0 (or H'0, or A0).
177 KFRES=KFHIGG
178
179 ELSEIF(ISUB.EQ.4) THEN
180C...gamma + W+/- -> W+/-.
181
182 ELSEIF(ISUB.EQ.5) THEN
183C...Z0 + Z0 -> H0.
184 XH=SH/SHP
185 MINT(21)=MINT(15)
186 MINT(22)=MINT(16)
187 PMQ(1)=ULMASS(MINT(21))
188 PMQ(2)=ULMASS(MINT(22))
189 220 JT=INT(1.5+RLU(0))
190 ZMIN=2.*PMQ(JT)/SHPR
191 ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT)))
192 ZMAX=MIN(1.-XH,ZMAX)
193 Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU(0)
194 IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT.
195 & (1.-XH)**2/(4.*XH)*RLU(0)) GOTO 220
196 SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP)
197 IF(SQC1.LT.1.E-8) GOTO 220
198 C1=SQRT(SQC1)
199 C2=1.+2.*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
200 CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
201 CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT)))
202 Z(3-JT)=1.-XH/(1.-Z(JT))
203 SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
204 IF(SQC1.LT.1.E-8) GOTO 220
205 C1=SQRT(SQC1)
206 C2=1.+2.*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
207 CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
208 CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT)))
209 PHIR=PARU(2)*RLU(0)
210 CPHI=COS(PHIR)
211 ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI
212 Z1=2.-Z(JT)
213 Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP)
214 Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
215 Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
216 & PMQ(3-JT)**2/SHP))
217 ZMIN=2.*PMQ(3-JT)/SHPR
218 ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
219 ZMAX=MIN(1.-XH,ZMAX)
220 IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 220
221 KCC=22
222 KFRES=25
223
224 ELSEIF(ISUB.EQ.6) THEN
225C...Z0 + W+/- -> W+/-.
226
227 ELSEIF(ISUB.EQ.7) THEN
228C...W+ + W- -> Z0.
229
230 ELSEIF(ISUB.EQ.8) THEN
231C...W+ + W- -> H0.
232 XH=SH/SHP
233 230 DO 260 JT=1,2
234 I=MINT(14+JT)
235 IA=IABS(I)
236 IF(IA.LE.10) THEN
237 RVCKM=VINT(180+I)*RLU(0)
238 DO 240 J=1,MSTP(1)
239 IB=2*J-1+MOD(IA,2)
240 IPM=(5-ISIGN(1,I))/2
241 IDC=J+MDCY(IA,2)+2
242 IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 240
243 MINT(20+JT)=ISIGN(IB,I)
244 RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
245 IF(RVCKM.LE.0.) GOTO 250
246 240 CONTINUE
247 ELSE
248 IB=2*((IA+1)/2)-1+MOD(IA,2)
249 MINT(20+JT)=ISIGN(IB,I)
250 ENDIF
251 250 PMQ(JT)=ULMASS(MINT(20+JT))
252 260 CONTINUE
253 JT=INT(1.5+RLU(0))
254 ZMIN=2.*PMQ(JT)/SHPR
255 ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT)))
256 ZMAX=MIN(1.-XH,ZMAX)
257 IF(ZMIN.GE.ZMAX) GOTO 230
258 Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU(0)
259 IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT.
260 & (1.-XH)**2/(4.*XH)*RLU(0)) GOTO 230
261 SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP)
262 IF(SQC1.LT.1.E-8) GOTO 230
263 C1=SQRT(SQC1)
264 C2=1.+2.*(PMAS(24,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
265 CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
266 CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT)))
267 Z(3-JT)=1.-XH/(1.-Z(JT))
268 SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
269 IF(SQC1.LT.1.E-8) GOTO 230
270 C1=SQRT(SQC1)
271 C2=1.+2.*(PMAS(24,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
272 CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
273 CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT)))
274 PHIR=PARU(2)*RLU(0)
275 CPHI=COS(PHIR)
276 ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI
277 Z1=2.-Z(JT)
278 Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP)
279 Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
280 Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
281 & PMQ(3-JT)**2/SHP))
282 ZMIN=2.*PMQ(3-JT)/SHPR
283 ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
284 ZMAX=MIN(1.-XH,ZMAX)
285 IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 230
286 KCC=22
287 KFRES=25
288
289 ELSEIF(ISUB.EQ.10) THEN
290C...f + f' -> f + f' (gamma/Z/W exchange); th = (p(f)-p(f))**2.
291 IF(MINT(2).EQ.1) THEN
292 KCC=22
293 ELSE
294C...W exchange: need to mix flavours according to CKM matrix.
295 DO 280 JT=1,2
296 I=MINT(14+JT)
297 IA=IABS(I)
298 IF(IA.LE.10) THEN
299 RVCKM=VINT(180+I)*RLU(0)
300 DO 270 J=1,MSTP(1)
301 IB=2*J-1+MOD(IA,2)
302 IPM=(5-ISIGN(1,I))/2
303 IDC=J+MDCY(IA,2)+2
304 IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 270
305 MINT(20+JT)=ISIGN(IB,I)
306 RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
307 IF(RVCKM.LE.0.) GOTO 280
308 270 CONTINUE
309 ELSE
310 IB=2*((IA+1)/2)-1+MOD(IA,2)
311 MINT(20+JT)=ISIGN(IB,I)
312 ENDIF
313 280 CONTINUE
314 KCC=22
315 ENDIF
316 ENDIF
317
318 ELSEIF(ISUB.LE.20) THEN
319 IF(ISUB.EQ.11) THEN
320C...f + f' -> f + f' (g exchange); th = (p(f)-p(f))**2.
321 KCC=MINT(2)
322 IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2
323
324 ELSEIF(ISUB.EQ.12) THEN
325C...f + f~ -> f' + f~'; th = (p(f)-p(f'))**2.
326 MINT(21)=ISIGN(KFLF,MINT(15))
327 MINT(22)=-MINT(21)
328 KCC=4
329
330 ELSEIF(ISUB.EQ.13) THEN
331C...f + f~ -> g + g; th arbitrary.
332 MINT(21)=21
333 MINT(22)=21
334 KCC=MINT(2)+4
335
336 ELSEIF(ISUB.EQ.14) THEN
337C...f + f~ -> g + gamma; th arbitrary.
338 IF(RLU(0).GT.0.5) JS=2
339 MINT(20+JS)=21
340 MINT(23-JS)=22
341 KCC=17+JS
342
343 ELSEIF(ISUB.EQ.15) THEN
344C...f + f~ -> g + Z0; th arbitrary.
345 IF(RLU(0).GT.0.5) JS=2
346 MINT(20+JS)=21
347 MINT(23-JS)=23
348 KCC=17+JS
349
350 ELSEIF(ISUB.EQ.16) THEN
351C...f + f~' -> g + W+/-; th = (p(f)-p(W-))**2 or (p(f~')-p(W+))**2.
352 KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
353 KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
354 IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2
355 MINT(20+JS)=21
356 MINT(23-JS)=ISIGN(24,KCH1+KCH2)
357 KCC=17+JS
358
359 ELSEIF(ISUB.EQ.17) THEN
360C...f + f~ -> g + H0; th arbitrary.
361 IF(RLU(0).GT.0.5) JS=2
362 MINT(20+JS)=21
363 MINT(23-JS)=25
364 KCC=17+JS
365
366 ELSEIF(ISUB.EQ.18) THEN
367C...f + f~ -> gamma + gamma; th arbitrary.
368 MINT(21)=22
369 MINT(22)=22
370
371 ELSEIF(ISUB.EQ.19) THEN
372C...f + f~ -> gamma + Z0; th arbitrary.
373 IF(RLU(0).GT.0.5) JS=2
374 MINT(20+JS)=22
375 MINT(23-JS)=23
376
377 ELSEIF(ISUB.EQ.20) THEN
378C...f + f~' -> gamma + W+/-; th = (p(f)-p(W-))**2 or (p(f~')-p(W+))**2.
379 KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
380 KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
381 IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2
382 MINT(20+JS)=22
383 MINT(23-JS)=ISIGN(24,KCH1+KCH2)
384 ENDIF
385
386 ELSEIF(ISUB.LE.30) THEN
387 IF(ISUB.EQ.21) THEN
388C...f + f~ -> gamma + H0; th arbitrary.
389 IF(RLU(0).GT.0.5) JS=2
390 MINT(20+JS)=22
391 MINT(23-JS)=25
392
393 ELSEIF(ISUB.EQ.22) THEN
394C...f + f~ -> Z0 + Z0; th arbitrary.
395 MINT(21)=23
396 MINT(22)=23
397
398 ELSEIF(ISUB.EQ.23) THEN
399C...f + f~' -> Z0 + W+/-; th = (p(f)-p(W-))**2 or (p(f~')-p(W+))**2.
400 KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
401 KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
402 IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2
403 MINT(20+JS)=23
404 MINT(23-JS)=ISIGN(24,KCH1+KCH2)
405
406 ELSEIF(ISUB.EQ.24) THEN
407C...f + f~ -> Z0 + H0 (or H'0, or A0); th arbitrary.
408 IF(RLU(0).GT.0.5) JS=2
409 MINT(20+JS)=23
410 MINT(23-JS)=KFHIGG
411
412 ELSEIF(ISUB.EQ.25) THEN
413C...f + f~ -> W+ + W-; th = (p(f)-p(W-))**2.
414 MINT(21)=-ISIGN(24,MINT(15))
415 MINT(22)=-MINT(21)
416
417 ELSEIF(ISUB.EQ.26) THEN
418C...f + f~' -> W+/- + H0 (or H'0, or A0);
419C...th = (p(f)-p(W-))**2 or (p(f~')-p(W+))**2.
420 KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
421 KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
422 IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2
423 MINT(20+JS)=ISIGN(24,KCH1+KCH2)
424 MINT(23-JS)=KFHIGG
425
426 ELSEIF(ISUB.EQ.27) THEN
427C...f + f~ -> H0 + H0.
428
429 ELSEIF(ISUB.EQ.28) THEN
430C...f + g -> f + g; th = (p(f)-p(f))**2.
431 KCC=MINT(2)+6
432 IF(MINT(15).EQ.21) KCC=KCC+2
433 IF(MINT(15).NE.21) KCS=ISIGN(1,MINT(15))
434 IF(MINT(16).NE.21) KCS=ISIGN(1,MINT(16))
435
436 ELSEIF(ISUB.EQ.29) THEN
437C...f + g -> f + gamma; th = (p(f)-p(f))**2.
438 IF(MINT(15).EQ.21) JS=2
439 MINT(23-JS)=22
440 KCC=15+JS
441 KCS=ISIGN(1,MINT(14+JS))
442
443 ELSEIF(ISUB.EQ.30) THEN
444C...f + g -> f + Z0; th = (p(f)-p(f))**2.
445 IF(MINT(15).EQ.21) JS=2
446 MINT(23-JS)=23
447 KCC=15+JS
448 KCS=ISIGN(1,MINT(14+JS))
449 ENDIF
450
451 ELSEIF(ISUB.LE.40) THEN
452 IF(ISUB.EQ.31) THEN
453C...f + g -> f' + W+/-; th = (p(f)-p(f'))**2; choose flavour f'.
454 IF(MINT(15).EQ.21) JS=2
455 I=MINT(14+JS)
456 IA=IABS(I)
457 MINT(23-JS)=ISIGN(24,KCHG(IA,1)*I)
458 RVCKM=VINT(180+I)*RLU(0)
459 DO 290 J=1,MSTP(1)
460 IB=2*J-1+MOD(IA,2)
461 IPM=(5-ISIGN(1,I))/2
462 IDC=J+MDCY(IA,2)+2
463 IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 290
464 MINT(20+JS)=ISIGN(IB,I)
465 RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
466 IF(RVCKM.LE.0.) GOTO 300
467 290 CONTINUE
468 300 KCC=15+JS
469 KCS=ISIGN(1,MINT(14+JS))
470
471 ELSEIF(ISUB.EQ.32) THEN
472C...f + g -> f + H0; th = (p(f)-p(f))**2.
473 IF(MINT(15).EQ.21) JS=2
474 MINT(23-JS)=25
475 KCC=15+JS
476 KCS=ISIGN(1,MINT(14+JS))
477
478 ELSEIF(ISUB.EQ.33) THEN
479C...f + gamma -> f + g; th=(p(f)-p(f))**2.
480 IF(MINT(15).EQ.22) JS=2
481 MINT(23-JS)=21
482 KCC=24+JS
483 KCS=ISIGN(1,MINT(14+JS))
484
485 ELSEIF(ISUB.EQ.34) THEN
486C...f + gamma -> f + gamma; th=(p(f)-p(f))**2.
487 IF(MINT(15).EQ.22) JS=2
488 KCC=22
489 KCS=ISIGN(1,MINT(14+JS))
490
491 ELSEIF(ISUB.EQ.35) THEN
492C...f + gamma -> f + Z0; th=(p(f)-p(f))**2.
493 IF(MINT(15).EQ.22) JS=2
494 MINT(23-JS)=23
495 KCC=22
496
497 ELSEIF(ISUB.EQ.36) THEN
498C...f + gamma -> f' + W+/-; th=(p(f)-p(f'))**2.
499 IF(MINT(15).EQ.22) JS=2
500 I=MINT(14+JS)
501 IA=IABS(I)
502 MINT(23-JS)=ISIGN(24,KCHG(IA,1)*I)
503 IF(IA.LE.10) THEN
504 RVCKM=VINT(180+I)*RLU(0)
505 DO 310 J=1,MSTP(1)
506 IB=2*J-1+MOD(IA,2)
507 IPM=(5-ISIGN(1,I))/2
508 IDC=J+MDCY(IA,2)+2
509 IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 310
510 MINT(20+JS)=ISIGN(IB,I)
511 RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
512 IF(RVCKM.LE.0.) GOTO 320
513 310 CONTINUE
514 ELSE
515 IB=2*((IA+1)/2)-1+MOD(IA,2)
516 MINT(20+JS)=ISIGN(IB,I)
517 ENDIF
518 320 KCC=22
519
520 ELSEIF(ISUB.EQ.37) THEN
521C...f + gamma -> f + H0.
522
523 ELSEIF(ISUB.EQ.38) THEN
524C...f + Z0 -> f + g.
525
526 ELSEIF(ISUB.EQ.39) THEN
527C...f + Z0 -> f + gamma.
528
529 ELSEIF(ISUB.EQ.40) THEN
530C...f + Z0 -> f + Z0.
531 ENDIF
532
533 ELSEIF(ISUB.LE.50) THEN
534 IF(ISUB.EQ.41) THEN
535C...f + Z0 -> f' + W+/-.
536
537 ELSEIF(ISUB.EQ.42) THEN
538C...f + Z0 -> f + H0.
539
540 ELSEIF(ISUB.EQ.43) THEN
541C...f + W+/- -> f' + g.
542
543 ELSEIF(ISUB.EQ.44) THEN
544C...f + W+/- -> f' + gamma.
545
546 ELSEIF(ISUB.EQ.45) THEN
547C...f + W+/- -> f' + Z0.
548
549 ELSEIF(ISUB.EQ.46) THEN
550C...f + W+/- -> f' + W+/-.
551
552 ELSEIF(ISUB.EQ.47) THEN
553C...f + W+/- -> f' + H0.
554
555 ELSEIF(ISUB.EQ.48) THEN
556C...f + H0 -> f + g.
557
558 ELSEIF(ISUB.EQ.49) THEN
559C...f + H0 -> f + gamma.
560
561 ELSEIF(ISUB.EQ.50) THEN
562C...f + H0 -> f + Z0.
563 ENDIF
564
565 ELSEIF(ISUB.LE.60) THEN
566 IF(ISUB.EQ.51) THEN
567C...f + H0 -> f' + W+/-.
568
569 ELSEIF(ISUB.EQ.52) THEN
570C...f + H0 -> f + H0.
571
572 ELSEIF(ISUB.EQ.53) THEN
573C...g + g -> f + f~; th arbitrary.
574 KCS=(-1)**INT(1.5+RLU(0))
575 MINT(21)=ISIGN(KFLF,KCS)
576 MINT(22)=-MINT(21)
577 KCC=MINT(2)+10
578
579 ELSEIF(ISUB.EQ.54) THEN
580C...g + gamma -> f + f~; th arbitrary.
581 KCS=(-1)**INT(1.5+RLU(0))
582 MINT(21)=ISIGN(KFLF,KCS)
583 MINT(22)=-MINT(21)
584 KCC=27
585 IF(MINT(16).EQ.21) KCC=28
586
587 ELSEIF(ISUB.EQ.55) THEN
588C...g + Z0 -> f + f~.
589
590 ELSEIF(ISUB.EQ.56) THEN
591C...g + W+/- -> f + f~'.
592
593 ELSEIF(ISUB.EQ.57) THEN
594C...g + H0 -> f + f~.
595
596 ELSEIF(ISUB.EQ.58) THEN
597C...gamma + gamma -> f + f~; th arbitrary.
598 KCS=(-1)**INT(1.5+RLU(0))
599 MINT(21)=ISIGN(KFLF,KCS)
600 MINT(22)=-MINT(21)
601 KCC=21
602
603 ELSEIF(ISUB.EQ.59) THEN
604C...gamma + Z0 -> f + f~.
605
606 ELSEIF(ISUB.EQ.60) THEN
607C...gamma + W+/- -> f + f~'.
608 ENDIF
609
610 ELSEIF(ISUB.LE.70) THEN
611 IF(ISUB.EQ.61) THEN
612C...gamma + H0 -> f + f~.
613
614 ELSEIF(ISUB.EQ.62) THEN
615C...Z0 + Z0 -> f + f~.
616
617 ELSEIF(ISUB.EQ.63) THEN
618C...Z0 + W+/- -> f + f~'.
619
620 ELSEIF(ISUB.EQ.64) THEN
621C...Z0 + H0 -> f + f~.
622
623 ELSEIF(ISUB.EQ.65) THEN
624C...W+ + W- -> f + f~.
625
626 ELSEIF(ISUB.EQ.66) THEN
627C...W+/- + H0 -> f + f~'.
628
629 ELSEIF(ISUB.EQ.67) THEN
630C...H0 + H0 -> f + f~.
631
632 ELSEIF(ISUB.EQ.68) THEN
633C...g + g -> g + g; th arbitrary.
634 KCC=MINT(2)+12
635 KCS=(-1)**INT(1.5+RLU(0))
636
637 ELSEIF(ISUB.EQ.69) THEN
638C...gamma + gamma -> W+ + W-; th arbitrary.
639 MINT(21)=24
640 MINT(22)=-24
641 KCC=21
642
643 ELSEIF(ISUB.EQ.70) THEN
644C...gamma + W+/- -> Z0 + W+/-; th=(p(W)-p(W))**2.
645 IF(MINT(15).EQ.22) MINT(21)=23
646 IF(MINT(16).EQ.22) MINT(22)=23
647 KCC=21
648 ENDIF
649
650 ELSEIF(ISUB.LE.80) THEN
651 IF(ISUB.EQ.71.OR.ISUB.EQ.72) THEN
652C...Z0 + Z0 -> Z0 + Z0; Z0 + Z0 -> W+ + W-.
653 XH=SH/SHP
654 MINT(21)=MINT(15)
655 MINT(22)=MINT(16)
656 PMQ(1)=ULMASS(MINT(21))
657 PMQ(2)=ULMASS(MINT(22))
658 330 JT=INT(1.5+RLU(0))
659 ZMIN=2.*PMQ(JT)/SHPR
660 ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT)))
661 ZMAX=MIN(1.-XH,ZMAX)
662 Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU(0)
663 IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT.
664 & (1.-XH)**2/(4.*XH)*RLU(0)) GOTO 330
665 SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP)
666 IF(SQC1.LT.1.E-8) GOTO 330
667 C1=SQRT(SQC1)
668 C2=1.+2.*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
669 CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
670 CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT)))
671 Z(3-JT)=1.-XH/(1.-Z(JT))
672 SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
673 IF(SQC1.LT.1.E-8) GOTO 330
674 C1=SQRT(SQC1)
675 C2=1.+2.*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
676 CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
677 CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT)))
678 PHIR=PARU(2)*RLU(0)
679 CPHI=COS(PHIR)
680 ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI
681 Z1=2.-Z(JT)
682 Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP)
683 Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
684 Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
685 & PMQ(3-JT)**2/SHP))
686 ZMIN=2.*PMQ(3-JT)/SHPR
687 ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
688 ZMAX=MIN(1.-XH,ZMAX)
689 IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 330
690 KCC=22
691
692 ELSEIF(ISUB.EQ.73) THEN
693C...Z0 + W+/- -> Z0 + W+/-.
694 JS=MINT(2)
695 XH=SH/SHP
696 340 JT=3-MINT(2)
697 I=MINT(14+JT)
698 IA=IABS(I)
699 IF(IA.LE.10) THEN
700 RVCKM=VINT(180+I)*RLU(0)
701 DO 350 J=1,MSTP(1)
702 IB=2*J-1+MOD(IA,2)
703 IPM=(5-ISIGN(1,I))/2
704 IDC=J+MDCY(IA,2)+2
705 IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 350
706 MINT(20+JT)=ISIGN(IB,I)
707 RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
708 IF(RVCKM.LE.0.) GOTO 360
709 350 CONTINUE
710 ELSE
711 IB=2*((IA+1)/2)-1+MOD(IA,2)
712 MINT(20+JT)=ISIGN(IB,I)
713 ENDIF
714 360 PMQ(JT)=ULMASS(MINT(20+JT))
715 MINT(23-JT)=MINT(17-JT)
716 PMQ(3-JT)=ULMASS(MINT(23-JT))
717 JT=INT(1.5+RLU(0))
718 ZMIN=2.*PMQ(JT)/SHPR
719 ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT)))
720 ZMAX=MIN(1.-XH,ZMAX)
721 IF(ZMIN.GE.ZMAX) GOTO 340
722 Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU(0)
723 IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT.
724 & (1.-XH)**2/(4.*XH)*RLU(0)) GOTO 340
725 SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP)
726 IF(SQC1.LT.1.E-8) GOTO 340
727 C1=SQRT(SQC1)
728 C2=1.+2.*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
729 CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
730 CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT)))
731 Z(3-JT)=1.-XH/(1.-Z(JT))
732 SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
733 IF(SQC1.LT.1.E-8) GOTO 340
734 C1=SQRT(SQC1)
735 C2=1.+2.*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
736 CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
737 CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT)))
738 PHIR=PARU(2)*RLU(0)
739 CPHI=COS(PHIR)
740 ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI
741 Z1=2.-Z(JT)
742 Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP)
743 Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
744 Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
745 & PMQ(3-JT)**2/SHP))
746 ZMIN=2.*PMQ(3-JT)/SHPR
747 ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
748 ZMAX=MIN(1.-XH,ZMAX)
749 IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 340
750 KCC=22
751
752 ELSEIF(ISUB.EQ.74) THEN
753C...Z0 + H0 -> Z0 + H0.
754
755 ELSEIF(ISUB.EQ.75) THEN
756C...W+ + W- -> gamma + gamma.
757
758 ELSEIF(ISUB.EQ.76.OR.ISUB.EQ.77) THEN
759C...W+ + W- -> Z0 + Z0; W+ + W- -> W+ + W-.
760 XH=SH/SHP
761 370 DO 400 JT=1,2
762 I=MINT(14+JT)
763 IA=IABS(I)
764 IF(IA.LE.10) THEN
765 RVCKM=VINT(180+I)*RLU(0)
766 DO 380 J=1,MSTP(1)
767 IB=2*J-1+MOD(IA,2)
768 IPM=(5-ISIGN(1,I))/2
769 IDC=J+MDCY(IA,2)+2
770 IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 380
771 MINT(20+JT)=ISIGN(IB,I)
772 RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
773 IF(RVCKM.LE.0.) GOTO 390
774 380 CONTINUE
775 ELSE
776 IB=2*((IA+1)/2)-1+MOD(IA,2)
777 MINT(20+JT)=ISIGN(IB,I)
778 ENDIF
779 390 PMQ(JT)=ULMASS(MINT(20+JT))
780 400 CONTINUE
781 JT=INT(1.5+RLU(0))
782 ZMIN=2.*PMQ(JT)/SHPR
783 ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT)))
784 ZMAX=MIN(1.-XH,ZMAX)
785 IF(ZMIN.GE.ZMAX) GOTO 370
786 Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU(0)
787 IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT.
788 & (1.-XH)**2/(4.*XH)*RLU(0)) GOTO 370
789 SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP)
790 IF(SQC1.LT.1.E-8) GOTO 370
791 C1=SQRT(SQC1)
792 C2=1.+2.*(PMAS(24,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
793 CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
794 CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT)))
795 Z(3-JT)=1.-XH/(1.-Z(JT))
796 SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
797 IF(SQC1.LT.1.E-8) GOTO 370
798 C1=SQRT(SQC1)
799 C2=1.+2.*(PMAS(24,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
800 CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
801 CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT)))
802 PHIR=PARU(2)*RLU(0)
803 CPHI=COS(PHIR)
804 ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI
805 Z1=2.-Z(JT)
806 Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP)
807 Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
808 Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
809 & PMQ(3-JT)**2/SHP))
810 ZMIN=2.*PMQ(3-JT)/SHPR
811 ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
812 ZMAX=MIN(1.-XH,ZMAX)
813 IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 370
814 KCC=22
815
816 ELSEIF(ISUB.EQ.78) THEN
817C...W+/- + H0 -> W+/- + H0.
818
819 ELSEIF(ISUB.EQ.79) THEN
820C...H0 + H0 -> H0 + H0.
821
822 ELSEIF(ISUB.EQ.80) THEN
823C...q + gamma -> q' + pi+/-; th=(p(q)-p(q'))**2.
824 IF(MINT(15).EQ.22) JS=2
825 I=MINT(14+JS)
826 IA=IABS(I)
827 MINT(23-JS)=ISIGN(211,KCHG(IA,1)*I)
828 IB=3-IA
829 MINT(20+JS)=ISIGN(IB,I)
830 KCC=22
831 ENDIF
832
833 ELSEIF(ISUB.LE.90) THEN
834 IF(ISUB.EQ.81) THEN
835C...q + q~ -> Q + Q~; th = (p(q)-p(Q))**2.
836 MINT(21)=ISIGN(MINT(55),MINT(15))
837 MINT(22)=-MINT(21)
838 KCC=4
839
840 ELSEIF(ISUB.EQ.82) THEN
841C...g + g -> Q + Q~; th arbitrary.
842 KCS=(-1)**INT(1.5+RLU(0))
843 MINT(21)=ISIGN(MINT(55),KCS)
844 MINT(22)=-MINT(21)
845 KCC=MINT(2)+10
846
847 ELSEIF(ISUB.EQ.83) THEN
848C...f + q -> f' + Q; th = (p(f) - p(f'))**2.
849 KFOLD=MINT(16)
850 IF(MINT(2).EQ.2) KFOLD=MINT(15)
851 KFAOLD=IABS(KFOLD)
852 IF(KFAOLD.GT.10) THEN
853 KFANEW=KFAOLD+2*MOD(KFAOLD,2)-1
854 ELSE
855 RCKM=VINT(180+KFOLD)*RLU(0)
856 IPM=(5-ISIGN(1,KFOLD))/2
857 KFANEW=-MOD(KFAOLD+1,2)
858 410 KFANEW=KFANEW+2
859 IDC=MDCY(KFAOLD,2)+(KFANEW+1)/2+2
860 IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.IPM) THEN
861 IF(MOD(KFAOLD,2).EQ.0) RCKM=RCKM-VCKM(KFAOLD/2,(KFANEW+1)/2)
862 IF(MOD(KFAOLD,2).EQ.1) RCKM=RCKM-VCKM(KFANEW/2,(KFAOLD+1)/2)
863 ENDIF
864 IF(KFANEW.LE.6.AND.RCKM.GT.0.) GOTO 410
865 ENDIF
866 IF(MINT(2).EQ.1) THEN
867 MINT(21)=ISIGN(MINT(55),MINT(15))
868 MINT(22)=ISIGN(KFANEW,MINT(16))
869 ELSE
870 MINT(21)=ISIGN(KFANEW,MINT(15))
871 MINT(22)=ISIGN(MINT(55),MINT(16))
872 JS=2
873 ENDIF
874 KCC=22
875
876 ELSEIF(ISUB.EQ.84) THEN
877C...g + gamma -> Q + Q~; th arbitary.
878 KCS=(-1)**INT(1.5+RLU(0))
879 MINT(21)=ISIGN(MINT(55),KCS)
880 MINT(22)=-MINT(21)
881 KCC=27
882 IF(MINT(16).EQ.21) KCC=28
883
884 ELSEIF(ISUB.EQ.85) THEN
885C...gamma + gamma -> F + F~; th arbitary.
886 KCS=(-1)**INT(1.5+RLU(0))
887 MINT(21)=ISIGN(MINT(56),KCS)
888 MINT(22)=-MINT(21)
889 KCC=21
890
891 ELSEIF(ISUB.GE.86.AND.ISUB.LE.89) THEN
892C...g + g -> (J/Psi, chi_0c, chi_1c or chi_2c) + g
893 MINT(21)=KFPR(ISUB,1)
894 MINT(22)=KFPR(ISUB,2)
895 KCC=24
896 KCS=(-1)**INT(1.5+RLU(0))
897 ENDIF
898
899 ELSEIF(ISUB.LE.100) THEN
900 IF(ISUB.EQ.95) THEN
901C...Low-pT ( = energyless g + g -> g + g).
902 KCC=MINT(2)+12
903 KCS=(-1)**INT(1.5+RLU(0))
904
905 ELSEIF(ISUB.EQ.96) THEN
906C...Multiple interactions (should be reassigned to QCD process).
907 ENDIF
908
909 ELSEIF(ISUB.LE.110) THEN
910 IF(ISUB.EQ.101) THEN
911C...g + g -> gamma*/Z0.
912 KCC=21
913 KFRES=22
914
915 ELSEIF(ISUB.EQ.102) THEN
916C...g + g -> H0 (or H'0, or A0).
917 KCC=21
918 KFRES=KFHIGG
919
920 ELSEIF(ISUB.EQ.103) THEN
921C...gamma + gamma -> H0 (or H'0, or A0).
922 KCC=21
923 KFRES=KFHIGG
924
925 ELSEIF(ISUB.EQ.110) THEN
926C...f + f~ -> gamma + H0; th arbitrary.
927 IF(RLU(0).GT.0.5) JS=2
928 MINT(20+JS)=22
929 MINT(23-JS)=KFHIGG
930 ENDIF
931
932 ELSEIF(ISUB.LE.120) THEN
933 IF(ISUB.EQ.111) THEN
934C...f + f~ -> g + H0; th arbitrary.
935 IF(RLU(0).GT.0.5) JS=2
936 MINT(20+JS)=21
937 MINT(23-JS)=25
938 KCC=17+JS
939
940 ELSEIF(ISUB.EQ.112) THEN
941C...f + g -> f + H0; th = (p(f) - p(f))**2.
942 IF(MINT(15).EQ.21) JS=2
943 MINT(23-JS)=25
944 KCC=15+JS
945 KCS=ISIGN(1,MINT(14+JS))
946
947 ELSEIF(ISUB.EQ.113) THEN
948C...g + g -> g + H0; th arbitrary.
949 IF(RLU(0).GT.0.5) JS=2
950 MINT(23-JS)=25
951 KCC=22+JS
952 KCS=(-1)**INT(1.5+RLU(0))
953
954 ELSEIF(ISUB.EQ.114) THEN
955C...g + g -> gamma + gamma; th arbitrary.
956 IF(RLU(0).GT.0.5) JS=2
957 MINT(21)=22
958 MINT(22)=22
959 KCC=21
960
961 ELSEIF(ISUB.EQ.115) THEN
962C...g + g -> g + gamma; th arbitrary.
963 IF(RLU(0).GT.0.5) JS=2
964 MINT(23-JS)=22
965 KCC=22+JS
966 KCS=(-1)**INT(1.5+RLU(0))
967
968 ELSEIF(ISUB.EQ.116) THEN
969C...g + g -> gamma + Z0.
970
971 ELSEIF(ISUB.EQ.117) THEN
972C...g + g -> Z0 + Z0.
973
974 ELSEIF(ISUB.EQ.118) THEN
975C...g + g -> W+ + W-.
976 ENDIF
977
978 ELSEIF(ISUB.LE.140) THEN
979 IF(ISUB.EQ.121) THEN
980C...g + g -> Q + Q~ + H0.
981 KCS=(-1)**INT(1.5+RLU(0))
982 MINT(21)=ISIGN(KFPR(ISUBSV,2),KCS)
983 MINT(22)=-MINT(21)
984 KCC=11+INT(0.5+RLU(0))
985 KFRES=KFHIGG
986
987 ELSEIF(ISUB.EQ.122) THEN
988C...q + q~ -> Q + Q~ + H0.
989 MINT(21)=ISIGN(KFPR(ISUBSV,2),MINT(15))
990 MINT(22)=-MINT(21)
991 KCC=4
992 KFRES=KFHIGG
993
994 ELSEIF(ISUB.EQ.123) THEN
995C...f + f' -> f + f' + H0 (or H'0, or A0) (Z0 + Z0 -> H0 as
996C...inner process).
997 KCC=22
998 KFRES=KFHIGG
999
1000 ELSEIF(ISUB.EQ.124) THEN
1001C...f + f' -> f" + f"' + H0 (or H'0, or A) (W+ + W- -> H0 as
1002C...inner process).
1003 DO 430 JT=1,2
1004 I=MINT(14+JT)
1005 IA=IABS(I)
1006 IF(IA.LE.10) THEN
1007 RVCKM=VINT(180+I)*RLU(0)
1008 DO 420 J=1,MSTP(1)
1009 IB=2*J-1+MOD(IA,2)
1010 IPM=(5-ISIGN(1,I))/2
1011 IDC=J+MDCY(IA,2)+2
1012 IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 420
1013 MINT(20+JT)=ISIGN(IB,I)
1014 RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
1015 IF(RVCKM.LE.0.) GOTO 430
1016 420 CONTINUE
1017 ELSE
1018 IB=2*((IA+1)/2)-1+MOD(IA,2)
1019 MINT(20+JT)=ISIGN(IB,I)
1020 ENDIF
1021 430 CONTINUE
1022 KCC=22
1023 KFRES=KFHIGG
1024
1025 ELSEIF(ISUB.EQ.131) THEN
1026C...g + g -> Z0 + q + q~.
1027 MINT(21)=KFPR(131,1)
1028 MINT(22)=KFPR(131,2)
1029 MINT(23)=-MINT(22)
1030 KCC=MINT(2)+10
1031 KCS=1
1032 ENDIF
1033
1034 ELSEIF(ISUB.LE.160) THEN
1035 IF(ISUB.EQ.141) THEN
1036C...f + f~ -> gamma*/Z0/Z'0.
1037 KFRES=32
1038
1039 ELSEIF(ISUB.EQ.142) THEN
1040C...f + f~' -> W'+/- .
1041 KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
1042 KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
1043 KFRES=ISIGN(34,KCH1+KCH2)
1044
1045 ELSEIF(ISUB.EQ.143) THEN
1046C...f + f~' -> H+/-.
1047 KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
1048 KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
1049 KFRES=ISIGN(37,KCH1+KCH2)
1050
1051 ELSEIF(ISUB.EQ.144) THEN
1052C...f + f~' -> R.
1053 KFRES=ISIGN(40,MINT(15)+MINT(16))
1054
1055 ELSEIF(ISUB.EQ.145) THEN
1056C...q + l -> LQ (leptoquark).
1057 IF(IABS(MINT(16)).LE.8) JS=2
1058 KFRES=ISIGN(39,MINT(14+JS))
1059 KCC=28+JS
1060 KCS=ISIGN(1,MINT(14+JS))
1061
1062 ELSEIF(ISUB.EQ.147.OR.ISUB.EQ.148) THEN
1063C...q + g -> q* (excited quark).
1064 IF(MINT(15).EQ.21) JS=2
1065 KFRES=MINT(14+JS)+ISIGN(6,MINT(14+JS))
1066 KCC=30+JS
1067 KCS=ISIGN(1,MINT(14+JS))
1068
1069 ELSEIF(ISUB.EQ.149) THEN
1070C...g + g -> eta_techni.
1071 KFRES=38
1072 KCC=23
1073 KCS=(-1)**INT(1.5+RLU(0))
1074 ENDIF
1075
1076 ELSE
1077 IF(ISUB.EQ.161) THEN
1078C...f + g -> f' + H+/-; th = (p(f)-p(f'))**2.
1079 IF(MINT(15).EQ.21) JS=2
1080 I=MINT(14+JS)
1081 IA=IABS(I)
1082 MINT(23-JS)=ISIGN(37,KCHG(IA,1)*I)
1083 IB=IA+MOD(IA,2)-MOD(IA+1,2)
1084 MINT(20+JS)=ISIGN(IB,I)
1085 KCC=15+JS
1086 KCS=ISIGN(1,MINT(14+JS))
1087
1088 ELSEIF(ISUB.EQ.162) THEN
1089C...q + g -> LQ + l~; LQ=leptoquark; th=(p(q)-p(LQ))^2.
1090 IF(MINT(15).EQ.21) JS=2
1091 MINT(20+JS)=ISIGN(39,MINT(14+JS))
1092 KFLQL=KFDP(MDCY(39,2),2)
1093 MINT(23-JS)=-ISIGN(KFLQL,MINT(14+JS))
1094 KCC=15+JS
1095 KCS=ISIGN(1,MINT(14+JS))
1096
1097 ELSEIF(ISUB.EQ.163) THEN
1098C...g + g -> LQ + LQ~; LQ=leptoquark; th arbitrary.
1099 KCS=(-1)**INT(1.5+RLU(0))
1100 MINT(21)=ISIGN(39,KCS)
1101 MINT(22)=-MINT(21)
1102 KCC=MINT(2)+10
1103
1104 ELSEIF(ISUB.EQ.164) THEN
1105C...q + q~ -> LQ + LQ~; LQ=leptoquark; th=(p(q)-p(LQ))**2.
1106 MINT(21)=ISIGN(39,MINT(15))
1107 MINT(22)=-MINT(21)
1108 KCC=4
1109
1110 ELSEIF(ISUB.EQ.165) THEN
1111C...q + q~ -> l- + l+; th=(p(q)-p(l-))**2.
1112 MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15))
1113 MINT(22)=-MINT(21)
1114
1115 ELSEIF(ISUB.EQ.166) THEN
1116C...q + q~' -> l + nu; th=(p(u)-p(nu))**2 or (p(u~)-p(nu~))**2.
1117 IF(MOD(MINT(15),2).EQ.0) THEN
1118 MINT(21)=ISIGN(KFPR(ISUB,1)+1,MINT(15))
1119 MINT(22)=ISIGN(KFPR(ISUB,1),MINT(16))
1120 ELSE
1121 MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15))
1122 MINT(22)=ISIGN(KFPR(ISUB,1)+1,MINT(16))
1123 ENDIF
1124
1125 ELSEIF(ISUB.EQ.167.OR.ISUB.EQ.168) THEN
1126C...q + q' -> q" + q* (excited quark).
1127 KFQEXC=ISUB-166
1128 KFQSTR=ISUB-160
1129 JS=MINT(2)
1130 MINT(20+JS)=ISIGN(KFQSTR,MINT(14+JS))
1131 IF(IABS(MINT(15)).NE.KFQEXC.AND.IABS(MINT(16)).NE.KFQEXC)
1132 & MINT(23-JS)=ISIGN(KFQEXC,MINT(17-JS))
1133 KCC=22
1134 ENDIF
1135 ENDIF
1136
1137 IF(ISET(ISUB).EQ.11) THEN
1138C...Store documentation for user-defined processes.
1139 BEZUP=(PUP(1,4)-PUP(2,4))/(PUP(1,4)+PUP(2,4))
1140 KUPPO(1)=MINT(83)+5
1141 KUPPO(2)=MINT(83)+6
1142 I=MINT(83)+6
1143 DO 450 IUP=3,NUP
1144 KUPPO(IUP)=0
1145 IF(MSTP(128).GE.2.AND.KUP(IUP,3).NE.0) THEN
1146 IDOC=IDOC-1
1147 MINT(4)=MINT(4)-1
1148 GOTO 450
1149 ENDIF
1150 I=I+1
1151 KUPPO(IUP)=I
1152 K(I,1)=21
1153 K(I,2)=KUP(IUP,2)
1154 K(I,3)=0
1155 IF(KUP(IUP,3).NE.0) K(I,3)=KUPPO(KUP(IUP,3))
1156 K(I,4)=0
1157 K(I,5)=0
1158 DO 440 J=1,5
1159 P(I,J)=PUP(IUP,J)
1160 440 CONTINUE
1161 450 CONTINUE
1162 CALL LUDBRB(MINT(83)+7,MINT(83)+4+NUP,0.,VINT(24),0D0,0D0,
1163 & -DBLE(BEZUP))
1164
1165C...Store final state partons for user-defined processes.
1166 N=IPU2
1167 DO 470 IUP=3,NUP
1168 N=N+1
1169 K(N,1)=1
1170 IF(KUP(IUP,1).NE.1) K(N,1)=11
1171 K(N,2)=KUP(IUP,2)
1172 IF(MSTP(128).LE.0.OR.KUP(IUP,3).EQ.0) THEN
1173 K(N,3)=KUPPO(IUP)
1174 ELSE
1175 K(N,3)=MINT(84)+KUP(IUP,3)
1176 ENDIF
1177 K(N,4)=0
1178 K(N,5)=0
1179 DO 460 J=1,5
1180 P(N,J)=PUP(IUP,J)
1181 460 CONTINUE
1182 470 CONTINUE
1183 CALL LUDBRB(IPU3,N,0.,VINT(24),0D0,0D0,-DBLE(BEZUP))
1184
1185C...Arrange colour flow for user-defined processes.
1186 N=MINT(84)
1187 DO 480 IUP=1,NUP
1188 N=N+1
1189 IF(KCHG(LUCOMP(K(N,2)),2).EQ.0) GOTO 480
1190 IF(K(N,1).EQ.1) K(N,1)=3
1191 IF(K(N,1).EQ.11) K(N,1)=14
1192 IF(KUP(IUP,4).NE.0) K(N,4)=K(N,4)+MSTU(5)*(KUP(IUP,4)+MINT(84))
1193 IF(KUP(IUP,5).NE.0) K(N,5)=K(N,5)+MSTU(5)*(KUP(IUP,5)+MINT(84))
1194 IF(KUP(IUP,6).NE.0) K(N,4)=K(N,4)+KUP(IUP,6)+MINT(84)
1195 IF(KUP(IUP,7).NE.0) K(N,5)=K(N,5)+KUP(IUP,7)+MINT(84)
1196 480 CONTINUE
1197
1198 ELSEIF(IDOC.EQ.7) THEN
1199C...Resonance not decaying; store kinematics.
1200 I=MINT(83)+7
1201 K(IPU3,1)=1
1202 K(IPU3,2)=KFRES
1203 K(IPU3,3)=I
1204 P(IPU3,4)=SHUSER
1205 P(IPU3,5)=SHUSER
1206 K(I,1)=21
1207 K(I,2)=KFRES
1208 P(I,4)=SHUSER
1209 P(I,5)=SHUSER
1210 N=IPU3
1211 MINT(21)=KFRES
1212 MINT(22)=0
1213
1214C...Special cases: colour flow in g + g -> eta_techni, q + l -> LQ
1215C...and q + g -> q*.
1216 IF(KFRES.EQ.38.OR.IABS(KFRES).EQ.39.OR.(MSTP(6).EQ.1.AND.
1217 & (IABS(KFRES).EQ.7.OR.IABS(KFRES).EQ.8))) THEN
1218 K(IPU3,1)=3
1219 DO 490 J=1,2
1220 JC=J
1221 IF(KCS.EQ.-1) JC=3-J
1222 IF(ICOL(KCC,1,JC).NE.0.AND.K(IPU1,1).EQ.14) K(IPU1,J+3)=
1223 & MINT(84)+ICOL(KCC,1,JC)
1224 IF(ICOL(KCC,2,JC).NE.0.AND.K(IPU2,1).EQ.14) K(IPU2,J+3)=
1225 & MINT(84)+ICOL(KCC,2,JC)
1226 IF(ICOL(KCC,3,JC).NE.0.AND.K(IPU3,1).EQ.3) K(IPU3,J+3)=
1227 & MSTU(5)*(MINT(84)+ICOL(KCC,3,JC))
1228 490 CONTINUE
1229 ELSE
1230 K(IPU1,4)=IPU2
1231 K(IPU1,5)=IPU2
1232 K(IPU2,4)=IPU1
1233 K(IPU2,5)=IPU1
1234 ENDIF
1235
1236 ELSEIF(IDOC.EQ.8) THEN
1237C...2 -> 2 processes: store outgoing partons in their CM-frame.
1238 DO 500 JT=1,2
1239 I=MINT(84)+2+JT
1240 K(I,1)=1
1241 IF(IABS(MINT(20+JT)).LE.100) THEN
1242 IF(KCHG(IABS(MINT(20+JT)),2).NE.0) K(I,1)=3
1243 ENDIF
1244 K(I,2)=MINT(20+JT)
1245 K(I,3)=MINT(83)+IDOC+JT-2
1246 KFAA=IABS(K(I,2))
1247 IF(KFAA.GE.23.OR.(KFAA.EQ.6.AND.KFPR(ISUBSV,1).NE.0.AND.
1248 & MSTP(48).GE.1).OR.((KFAA.EQ.7.OR.KFAA.EQ.8.OR.KFAA.EQ.17.OR.
1249 & KFAA.EQ.18).AND.KFPR(ISUBSV,1).NE.0.AND.MSTP(49).GE.1)) THEN
1250 P(I,5)=SQRT(VINT(63+MOD(JS+JT,2)))
1251 ELSEIF((KFAA.EQ.7.OR.KFAA.EQ.8).AND.MSTP(6).EQ.1.AND.
1252 & KFPR(ISUBSV,2).NE.0) THEN
1253 P(I,5)=SQRT(VINT(64))
1254 ELSE
1255 P(I,5)=ULMASS(K(I,2))
1256 ENDIF
1257 500 CONTINUE
1258 IF(P(IPU3,5)+P(IPU4,5).GE.SHR) THEN
1259 KFA1=IABS(MINT(21))
1260 KFA2=IABS(MINT(22))
1261 IF((KFA1.GT.3.AND.KFA1.NE.21).OR.(KFA2.GT.3.AND.KFA2.NE.21))
1262 & THEN
1263 MINT(51)=1
1264 RETURN
1265 ENDIF
1266 P(IPU3,5)=0.
1267 P(IPU4,5)=0.
1268 ENDIF
1269 P(IPU3,4)=0.5*(SHR+(P(IPU3,5)**2-P(IPU4,5)**2)/SHR)
1270 P(IPU3,3)=SQRT(MAX(0.,P(IPU3,4)**2-P(IPU3,5)**2))
1271 P(IPU4,4)=SHR-P(IPU3,4)
1272 P(IPU4,3)=-P(IPU3,3)
1273 N=IPU4
1274 MINT(7)=MINT(83)+7
1275 MINT(8)=MINT(83)+8
1276
1277C...Rotate outgoing partons using cos(theta)=(th-uh)/lam(sh,sqm3,sqm4).
1278 CALL LUDBRB(IPU3,IPU4,ACOS(VINT(23)),VINT(24),0D0,0D0,0D0)
1279
1280 ELSEIF(IDOC.EQ.9.AND.ISET(ISUB).EQ.5) THEN
1281C...2 -> 3 processes (alt 1): store outgoing partons in their CM frame.
1282 DO 510 JT=1,2
1283 I=MINT(84)+2+JT
1284 K(I,1)=1
1285 IF(IABS(MINT(20+JT)).LE.100) THEN
1286 IF(KCHG(IABS(MINT(20+JT)),2).NE.0) K(I,1)=3
1287 ENDIF
1288 K(I,2)=MINT(20+JT)
1289 K(I,3)=MINT(83)+IDOC+JT-3
1290 IF(IABS(K(I,2)).LE.22) THEN
1291 P(I,5)=ULMASS(K(I,2))
1292 ELSE
1293 P(I,5)=SQRT(VINT(63+MOD(JS+JT,2)))
1294 ENDIF
1295 PT=SQRT(MAX(0.,VINT(197+5*JT)-P(I,5)**2+VINT(196+5*JT)**2))
1296 P(I,1)=PT*COS(VINT(198+5*JT))
1297 P(I,2)=PT*SIN(VINT(198+5*JT))
1298 510 CONTINUE
1299 K(IPU5,1)=1
1300 K(IPU5,2)=KFRES
1301 K(IPU5,3)=MINT(83)+IDOC
1302 P(IPU5,5)=SHR
1303 P(IPU5,1)=-P(IPU3,1)-P(IPU4,1)
1304 P(IPU5,2)=-P(IPU3,2)-P(IPU4,2)
1305 PMS1=P(IPU3,5)**2+P(IPU3,1)**2+P(IPU3,2)**2
1306 PMS2=P(IPU4,5)**2+P(IPU4,1)**2+P(IPU4,2)**2
1307 PMS3=P(IPU5,5)**2+P(IPU5,1)**2+P(IPU5,2)**2
1308 PMT3=SQRT(PMS3)
1309 P(IPU5,3)=PMT3*SINH(VINT(211))
1310 P(IPU5,4)=PMT3*COSH(VINT(211))
1311 PMS12=(SHPR-P(IPU5,4))**2-P(IPU5,3)**2
1312 SQL12=(PMS12-PMS1-PMS2)**2-4.*PMS1*PMS2
1313 IF(SQL12.LE.0.) THEN
1314 MINT(51)=1
1315 RETURN
1316 ENDIF
1317 P(IPU3,3)=(-P(IPU5,3)*(PMS12+PMS1-PMS2)+
1318 & VINT(213)*(SHPR-P(IPU5,4))*SQRT(SQL12))/(2.*PMS12)
1319 P(IPU4,3)=-P(IPU3,3)-P(IPU5,3)
1320 P(IPU3,4)=SQRT(PMS1+P(IPU3,3)**2)
1321 P(IPU4,4)=SQRT(PMS2+P(IPU4,3)**2)
1322 MINT(23)=KFRES
1323 N=IPU5
1324 MINT(7)=MINT(83)+7
1325 MINT(8)=MINT(83)+8
1326
1327 ELSEIF(IDOC.EQ.9) THEN
1328C...2 -> 3 processes: store outgoing partons in their CM frame.
1329 DO 520 JT=1,3
1330 I=MINT(84)+2+JT
1331 K(I,1)=1
1332 IF(IABS(MINT(20+JT)).LE.10.OR.MINT(20+JT).EQ.21) K(I,1)=3
1333 K(I,2)=MINT(20+JT)
1334 K(I,3)=MINT(83)+IDOC+JT-3
1335 IF(JT.EQ.1) THEN
1336 P(I,5)=SQRT(VINT(63))
1337 ELSE
1338 P(I,5)=PMAS(KFPR(ISUB,2),1)
1339 ENDIF
1340 520 CONTINUE
1341 P(IPU3,4)=0.5*(SHR+(VINT(63)-VINT(64))/SHR)
1342 P(IPU3,3)=SQRT(MAX(0.,P(IPU3,4)**2-P(IPU3,5)**2))
1343 P(IPU4,4)=0.5*SQRT(VINT(64))
1344 P(IPU4,3)=SQRT(MAX(0.,P(IPU4,4)**2-P(IPU4,5)**2))
1345 P(IPU5,4)=P(IPU4,4)
1346 P(IPU5,3)=-P(IPU4,3)
1347 N=IPU5
1348 MINT(7)=MINT(83)+7
1349 MINT(8)=MINT(83)+9
1350
1351C...Rotate and boost outgoing partons.
1352 CALL LUDBRB(IPU4,IPU5,ACOS(VINT(83)),VINT(84),0D0,0D0,0D0)
1353 CALL LUDBRB(IPU4,IPU5,0.,0.,0D0,0D0,
1354 & -DBLE(P(IPU3,3)/(SHR-P(IPU3,4))))
1355 CALL LUDBRB(IPU3,IPU5,ACOS(VINT(23)),VINT(24),0D0,0D0,0D0)
1356
1357 ELSEIF(IDOC.EQ.11) THEN
1358C...Z0 + Z0 -> H0, W+ + W- -> H0: store Higgs and outgoing partons.
1359 PHI(1)=PARU(2)*RLU(0)
1360 PHI(2)=PHI(1)-PHIR
1361 DO 530 JT=1,2
1362 I=MINT(84)+2+JT
1363 K(I,1)=1
1364 IF(IABS(MINT(20+JT)).LE.10.OR.MINT(20+JT).EQ.21) K(I,1)=3
1365 K(I,2)=MINT(20+JT)
1366 K(I,3)=MINT(83)+IDOC+JT-2
1367 P(I,5)=ULMASS(K(I,2))
1368 IF(0.5*SHPR*Z(JT).LE.P(I,5)) P(I,5)=0.
1369 PABS=SQRT(MAX(0.,(0.5*SHPR*Z(JT))**2-P(I,5)**2))
1370 PTABS=PABS*SQRT(MAX(0.,1.-CTHE(JT)**2))
1371 P(I,1)=PTABS*COS(PHI(JT))
1372 P(I,2)=PTABS*SIN(PHI(JT))
1373 P(I,3)=PABS*CTHE(JT)*(-1)**(JT+1)
1374 P(I,4)=0.5*SHPR*Z(JT)
1375 IZW=MINT(83)+6+JT
1376 K(IZW,1)=21
1377 K(IZW,2)=23
1378 IF(ISUB.EQ.8) K(IZW,2)=ISIGN(24,LUCHGE(MINT(14+JT)))
1379 K(IZW,3)=IZW-2
1380 P(IZW,1)=-P(I,1)
1381 P(IZW,2)=-P(I,2)
1382 P(IZW,3)=(0.5*SHPR-PABS*CTHE(JT))*(-1)**(JT+1)
1383 P(IZW,4)=0.5*SHPR*(1.-Z(JT))
1384 P(IZW,5)=-SQRT(MAX(0.,P(IZW,3)**2+PTABS**2-P(IZW,4)**2))
1385 530 CONTINUE
1386 I=MINT(83)+9
1387 K(IPU5,1)=1
1388 K(IPU5,2)=KFRES
1389 K(IPU5,3)=I
1390 P(IPU5,5)=SHR
1391 P(IPU5,1)=-P(IPU3,1)-P(IPU4,1)
1392 P(IPU5,2)=-P(IPU3,2)-P(IPU4,2)
1393 P(IPU5,3)=-P(IPU3,3)-P(IPU4,3)
1394 P(IPU5,4)=SHPR-P(IPU3,4)-P(IPU4,4)
1395 K(I,1)=21
1396 K(I,2)=KFRES
1397 DO 540 J=1,5
1398 P(I,J)=P(IPU5,J)
1399 540 CONTINUE
1400 N=IPU5
1401 MINT(23)=KFRES
1402
1403 ELSEIF(IDOC.EQ.12) THEN
1404C...Z0 and W+/- scattering: store bosons and outgoing partons.
1405 PHI(1)=PARU(2)*RLU(0)
1406 PHI(2)=PHI(1)-PHIR
1407 JTRAN=INT(1.5+RLU(0))
1408 DO 550 JT=1,2
1409 I=MINT(84)+2+JT
1410 K(I,1)=1
1411 IF(IABS(MINT(20+JT)).LE.10.OR.MINT(20+JT).EQ.21) K(I,1)=3
1412 K(I,2)=MINT(20+JT)
1413 K(I,3)=MINT(83)+IDOC+JT-2
1414 P(I,5)=ULMASS(K(I,2))
1415 IF(0.5*SHPR*Z(JT).LE.P(I,5)) P(I,5)=0.
1416 PABS=SQRT(MAX(0.,(0.5*SHPR*Z(JT))**2-P(I,5)**2))
1417 PTABS=PABS*SQRT(MAX(0.,1.-CTHE(JT)**2))
1418 P(I,1)=PTABS*COS(PHI(JT))
1419 P(I,2)=PTABS*SIN(PHI(JT))
1420 P(I,3)=PABS*CTHE(JT)*(-1)**(JT+1)
1421 P(I,4)=0.5*SHPR*Z(JT)
1422 IZW=MINT(83)+6+JT
1423 K(IZW,1)=21
1424 IF(MINT(14+JT).EQ.MINT(20+JT)) THEN
1425 K(IZW,2)=23
1426 ELSE
1427 K(IZW,2)=ISIGN(24,LUCHGE(MINT(14+JT))-LUCHGE(MINT(20+JT)))
1428 ENDIF
1429 K(IZW,3)=IZW-2
1430 P(IZW,1)=-P(I,1)
1431 P(IZW,2)=-P(I,2)
1432 P(IZW,3)=(0.5*SHPR-PABS*CTHE(JT))*(-1)**(JT+1)
1433 P(IZW,4)=0.5*SHPR*(1.-Z(JT))
1434 P(IZW,5)=-SQRT(MAX(0.,P(IZW,3)**2+PTABS**2-P(IZW,4)**2))
1435 IPU=MINT(84)+4+JT
1436 K(IPU,1)=3
1437 K(IPU,2)=KFPR(ISUB,JT)
1438 IF(ISUB.EQ.72.AND.JT.EQ.JTRAN) K(IPU,2)=-K(IPU,2)
1439 IF(ISUB.EQ.73.OR.ISUB.EQ.77) K(IPU,2)=K(IZW,2)
1440 K(IPU,3)=MINT(83)+8+JT
1441 IF(IABS(K(IPU,2)).LE.10.OR.K(IPU,2).EQ.21) THEN
1442 P(IPU,5)=ULMASS(K(IPU,2))
1443 ELSE
1444 P(IPU,5)=SQRT(VINT(63+MOD(JS+JT,2)))
1445 ENDIF
1446 MINT(22+JT)=K(IPU,2)
1447 550 CONTINUE
1448C...Find rotation and boost for hard scattering subsystem.
1449 I1=MINT(83)+7
1450 I2=MINT(83)+8
1451 BEXCM=(P(I1,1)+P(I2,1))/(P(I1,4)+P(I2,4))
1452 BEYCM=(P(I1,2)+P(I2,2))/(P(I1,4)+P(I2,4))
1453 BEZCM=(P(I1,3)+P(I2,3))/(P(I1,4)+P(I2,4))
1454 GAMCM=(P(I1,4)+P(I2,4))/SHR
1455 BEPCM=BEXCM*P(I1,1)+BEYCM*P(I1,2)+BEZCM*P(I1,3)
1456 PX=P(I1,1)+GAMCM*(GAMCM/(1.+GAMCM)*BEPCM-P(I1,4))*BEXCM
1457 PY=P(I1,2)+GAMCM*(GAMCM/(1.+GAMCM)*BEPCM-P(I1,4))*BEYCM
1458 PZ=P(I1,3)+GAMCM*(GAMCM/(1.+GAMCM)*BEPCM-P(I1,4))*BEZCM
1459 THECM=ULANGL(PZ,SQRT(PX**2+PY**2))
1460 PHICM=ULANGL(PX,PY)
1461C...Store hard scattering subsystem. Rotate and boost it.
1462 SQLAM=(SH-P(IPU5,5)**2-P(IPU6,5)**2)**2-4.*P(IPU5,5)**2*
1463 & P(IPU6,5)**2
1464 PABS=SQRT(MAX(0.,SQLAM/(4.*SH)))
1465 CTHWZ=VINT(23)
1466 STHWZ=SQRT(MAX(0.,1.-CTHWZ**2))
1467 PHIWZ=VINT(24)-PHICM
1468 P(IPU5,1)=PABS*STHWZ*COS(PHIWZ)
1469 P(IPU5,2)=PABS*STHWZ*SIN(PHIWZ)
1470 P(IPU5,3)=PABS*CTHWZ
1471 P(IPU5,4)=SQRT(PABS**2+P(IPU5,5)**2)
1472 P(IPU6,1)=-P(IPU5,1)
1473 P(IPU6,2)=-P(IPU5,2)
1474 P(IPU6,3)=-P(IPU5,3)
1475 P(IPU6,4)=SQRT(PABS**2+P(IPU6,5)**2)
1476 CALL LUDBRB(IPU5,IPU6,THECM,PHICM,DBLE(BEXCM),DBLE(BEYCM),
1477 & DBLE(BEZCM))
1478 DO 570 JT=1,2
1479 I1=MINT(83)+8+JT
1480 I2=MINT(84)+4+JT
1481 K(I1,1)=21
1482 K(I1,2)=K(I2,2)
1483 DO 560 J=1,5
1484 P(I1,J)=P(I2,J)
1485 560 CONTINUE
1486 570 CONTINUE
1487 N=IPU6
1488 MINT(7)=MINT(83)+9
1489 MINT(8)=MINT(83)+10
1490 ENDIF
1491
1492 IF(ISET(ISUB).EQ.11) THEN
1493 ELSEIF(IDOC.GE.8.AND.ISET(ISUB).NE.6) THEN
1494C...Store colour connection indices.
1495 DO 580 J=1,2
1496 JC=J
1497 IF(KCS.EQ.-1) JC=3-J
1498 IF(ICOL(KCC,1,JC).NE.0.AND.K(IPU1,1).EQ.14) K(IPU1,J+3)=
1499 & K(IPU1,J+3)+MINT(84)+ICOL(KCC,1,JC)
1500 IF(ICOL(KCC,2,JC).NE.0.AND.K(IPU2,1).EQ.14) K(IPU2,J+3)=
1501 & K(IPU2,J+3)+MINT(84)+ICOL(KCC,2,JC)
1502 IF(ICOL(KCC,3,JC).NE.0.AND.K(IPU3,1).EQ.3) K(IPU3,J+3)=
1503 & MSTU(5)*(MINT(84)+ICOL(KCC,3,JC))
1504 IF(ICOL(KCC,4,JC).NE.0.AND.K(IPU4,1).EQ.3) K(IPU4,J+3)=
1505 & MSTU(5)*(MINT(84)+ICOL(KCC,4,JC))
1506 580 CONTINUE
1507
1508C...Copy outgoing partons to documentation lines.
1509 IMAX=2
1510 IF(IDOC.EQ.9) IMAX=3
1511 DO 600 I=1,IMAX
1512 I1=MINT(83)+IDOC-IMAX+I
1513 I2=MINT(84)+2+I
1514 K(I1,1)=21
1515 K(I1,2)=K(I2,2)
1516 IF(IDOC.LE.9) K(I1,3)=0
1517 IF(IDOC.GE.11) K(I1,3)=MINT(83)+2+I
1518 DO 590 J=1,5
1519 P(I1,J)=P(I2,J)
1520 590 CONTINUE
1521 600 CONTINUE
1522
1523 ELSEIF(IDOC.EQ.9) THEN
1524C...Store colour connection indices.
1525 DO 610 J=1,2
1526 JC=J
1527 IF(KCS.EQ.-1) JC=3-J
1528 IF(ICOL(KCC,1,JC).NE.0.AND.K(IPU1,1).EQ.14) K(IPU1,J+3)=
1529 & K(IPU1,J+3)+MINT(84)+ICOL(KCC,1,JC)+
1530 & MAX(0,MIN(1,ICOL(KCC,1,JC)-2))
1531 IF(ICOL(KCC,2,JC).NE.0.AND.K(IPU2,1).EQ.14) K(IPU2,J+3)=
1532 & K(IPU2,J+3)+MINT(84)+ICOL(KCC,2,JC)+
1533 & MAX(0,MIN(1,ICOL(KCC,2,JC)-2))
1534 IF(ICOL(KCC,3,JC).NE.0.AND.K(IPU4,1).EQ.3) K(IPU4,J+3)=
1535 & MSTU(5)*(MINT(84)+ICOL(KCC,3,JC))
1536 IF(ICOL(KCC,4,JC).NE.0.AND.K(IPU5,1).EQ.3) K(IPU5,J+3)=
1537 & MSTU(5)*(MINT(84)+ICOL(KCC,4,JC))
1538 610 CONTINUE
1539
1540C...Copy outgoing partons to documentation lines.
1541 DO 630 I=1,3
1542 I1=MINT(83)+IDOC-3+I
1543 I2=MINT(84)+2+I
1544 K(I1,1)=21
1545 K(I1,2)=K(I2,2)
1546 K(I1,3)=0
1547 DO 620 J=1,5
1548 P(I1,J)=P(I2,J)
1549 620 CONTINUE
1550 630 CONTINUE
1551 ENDIF
1552
1553C...Low-pT events: remove gluons used for string drawing purposes.
1554 IF(ISUB.EQ.95) THEN
1555 K(IPU3,1)=K(IPU3,1)+10
1556 K(IPU4,1)=K(IPU4,1)+10
1557 DO 640 J=41,66
1558 VINTSV(J)=VINT(J)
1559 VINT(J)=0.
1560 640 CONTINUE
1561 DO 660 I=MINT(83)+5,MINT(83)+8
1562 DO 650 J=1,5
1563 P(I,J)=0.
1564 650 CONTINUE
1565 660 CONTINUE
1566 ENDIF
1567
1568 RETURN
1569 END