]> git.uio.no Git - u/mrichter/AliRoot.git/blame - PYTHIA/pythia/pysigh.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Make-depend automatically generated if not there.
[u/mrichter/AliRoot.git] / PYTHIA / pythia / pysigh.F
CommitLineData
fe4da5cc 1
2C***********************************************************************
3
4 SUBROUTINE PYSIGH(NCHN,SIGS)
5
6C...Differential matrix elements for all included subprocesses.
7C...Note that what is coded is (disregarding the COMFAC factor)
8C...1) for 2 -> 1 processes: s-hat/pi*d(sigma-hat), where,
9C...when d(sigma-hat) is given in the zero-width limit, the delta
10C...function in tau is replaced by a (modified) Breit-Wigner:
11C...1/pi*s*H_res/((s*tau-m_res^2)^2+H_res^2),
12C...where H_res = s-hat/m_res*Gamma_res(s-hat);
13C...2) for 2 -> 2 processes: (s-hat)**2/pi*d(sigma-hat)/d(t-hat);
14C...i.e., dimensionless quantities.
15C...3) for 2 -> 3 processes: abs(M)^2, where the total cross-section is
16C...Integral abs(M)^2/(2shat') * (prod_(i=1)^3 d^3p_i/((2pi)^3*2E_i)) *
17C...(2pi)^4 delta^4(P - sum p_i).
18C...COMFAC contains the factor pi/s (or equivalent) and
19C...the conversion factor from GeV^-2 to mb.
20 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
21 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
22 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
23 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
24 COMMON/PYSUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
25 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
26 COMMON/PYINT1/MINT(400),VINT(400)
27 COMMON/PYINT2/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2)
28 COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000)
29 COMMON/PYINT4/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3)
30 COMMON/PYINT5/NGEN(0:200,3),XSEC(0:200,3)
31 COMMON/PYINT7/SIGT(0:6,0:6,0:5)
32 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/
33 SAVE /PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/,
34 &/PYINT5/,/PYINT7/
35 DIMENSION X(2),XPQ(-25:25),KFAC(2,-40:40),WDTP(0:40),
36 &WDTE(0:40,0:5),HGZ(6,3),HL3(3),HR3(3),HL4(3),HR4(3)
37 COMPLEX A004,A204,A114,A00U,A20U,A11U
38 COMPLEX CIGTOT,CIZTOT,F0ALP,F1ALP,F2ALP,F0BET,F1BET,F2BET,FIF,
39 &COULCK,COULCP,COULCD,COULCR,COULCS
40
41C...The following gives an interface for process 131, gg -> Zqq,
42C...to the matrix element package of Ronald Kleiss.
43 COMMON/RKBBVC/RKMQ,RKMZ,RKGZ,RKVQ,RKAQ,RKVL,RKAL
44 SAVE /RKBBVC/
45 DIMENSION RKG1(0:3),RKG2(0:3),RKQ1(0:3),RKQ2(0:3),RKL1(0:3),
46 &RKL2(0:3)
47
48C...Reset number of channels and cross-section.
49 NCHN=0
50 SIGS=0.
51
52C...Convert H' or A process into equivalent H one.
53 ISUB=MINT(1)
54 ISUBSV=ISUB
55 IHIGG=1
56 KFHIGG=25
57 IF((ISUB.GE.151.AND.ISUB.LE.160).OR.(ISUB.GE.171.AND.
58 &ISUB.LE.190)) THEN
59 IHIGG=2
60 IF(MOD(ISUB-1,10).GE.5) IHIGG=3
61 KFHIGG=33+IHIGG
62 IF(ISUB.EQ.151.OR.ISUB.EQ.156) ISUB=3
63 IF(ISUB.EQ.152.OR.ISUB.EQ.157) ISUB=102
64 IF(ISUB.EQ.153.OR.ISUB.EQ.158) ISUB=103
65 IF(ISUB.EQ.171.OR.ISUB.EQ.176) ISUB=24
66 IF(ISUB.EQ.172.OR.ISUB.EQ.177) ISUB=26
67 IF(ISUB.EQ.173.OR.ISUB.EQ.178) ISUB=123
68 IF(ISUB.EQ.174.OR.ISUB.EQ.179) ISUB=124
69 IF(ISUB.EQ.181.OR.ISUB.EQ.186) ISUB=121
70 IF(ISUB.EQ.182.OR.ISUB.EQ.187) ISUB=122
71 ENDIF
72
73C...Read kinematical variables and limits.
74 ISTSB=ISET(ISUBSV)
75 TAUMIN=VINT(11)
76 YSTMIN=VINT(12)
77 CTNMIN=VINT(13)
78 CTPMIN=VINT(14)
79 TAUPMN=VINT(16)
80 TAU=VINT(21)
81 YST=VINT(22)
82 CTH=VINT(23)
83 XT2=VINT(25)
84 TAUP=VINT(26)
85 TAUMAX=VINT(31)
86 YSTMAX=VINT(32)
87 CTNMAX=VINT(33)
88 CTPMAX=VINT(34)
89 TAUPMX=VINT(36)
90
91C...Derive kinematical quantities.
92 TAUE=TAU
93 IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUE=TAUP
94 X(1)=SQRT(TAUE)*EXP(YST)
95 X(2)=SQRT(TAUE)*EXP(-YST)
96 IF(MINT(45).EQ.2.AND.ISTSB.GE.1) THEN
97 IF(X(1).GT.0.9999) RETURN
98 ELSEIF(MINT(45).EQ.3) THEN
99 X(1)=MIN(0.9999989,X(1))
100 ENDIF
101 IF(MINT(46).EQ.2.AND.ISTSB.GE.1) THEN
102 IF(X(2).GT.0.9999) RETURN
103 ELSEIF(MINT(46).EQ.3) THEN
104 X(2)=MIN(0.9999989,X(2))
105 ENDIF
106 SH=TAU*VINT(2)
107 SQM3=VINT(63)
108 SQM4=VINT(64)
109 RM3=SQM3/SH
110 RM4=SQM4/SH
111 BE34=SQRT(MAX(0.,(1.-RM3-RM4)**2-4.*RM3*RM4))
112 RPTS=4.*VINT(71)**2/SH
113 BE34L=SQRT(MAX(0.,(1.-RM3-RM4)**2-4.*RM3*RM4-RPTS))
114 RM34=MAX(1E-20,2.*RM3*RM4)
115 RSQM=1.+RM34
116 IF(2.*VINT(71)**2/(VINT(21)*VINT(2)).LT.0.0001) RM34=MAX(RM34,
117 &2.*VINT(71)**2/(VINT(21)*VINT(2)))
118 RTHM=(4.*RM3*RM4+RPTS)/(1.-RM3-RM4+BE34L)
119 IF(ISTSB.EQ.0) THEN
120 TH=VINT(45)
121 UH=-0.5*SH*MAX(RTHM,1.-RM3-RM4+BE34*CTH)
122 SQPTH=MAX(VINT(71)**2,0.25*SH*BE34**2*VINT(59)**2)
123 ELSE
124 TH=-0.5*SH*MAX(RTHM,1.-RM3-RM4-BE34*CTH)
125 UH=-0.5*SH*MAX(RTHM,1.-RM3-RM4+BE34*CTH)
126 SQPTH=MAX(VINT(71)**2,0.25*SH*BE34**2*(1.-CTH**2))
127 ENDIF
128 SH2=SH**2
129 TH2=TH**2
130 UH2=UH**2
131
132C...Choice of Q2 scale: hard, structure functions, parton showers.
133 IF(ISTSB.EQ.1.OR.ISTSB.EQ.3.OR.ISTSB.EQ.5) THEN
134 Q2=SH
135 ELSEIF(MOD(ISTSB,2).EQ.0.OR.ISTSB.EQ.9) THEN
136 IF(MSTP(32).EQ.1) THEN
137 Q2=2.*SH*TH*UH/(SH**2+TH**2+UH**2)
138 ELSEIF(MSTP(32).EQ.2) THEN
139 Q2=SQPTH+0.5*(SQM3+SQM4)
140 ELSEIF(MSTP(32).EQ.3) THEN
141 Q2=MIN(-TH,-UH)
142 ELSEIF(MSTP(32).EQ.4) THEN
143 Q2=SH
144 ELSEIF(MSTP(32).EQ.5) THEN
145 Q2=-TH
146 ENDIF
147 IF(ISTSB.EQ.9) Q2=SQPTH
148 IF((ISTSB.EQ.9.AND.MSTP(82).GE.2).OR.(ISTSB.NE.9.AND.
149 & MSTP(85).EQ.1)) Q2=Q2+PARP(82)**2
150 ENDIF
151 Q2SF=Q2
152 IF(ISTSB.GE.3.AND.ISTSB.LE.5) THEN
153 Q2SF=PMAS(23,1)**2
154 IF(ISUB.EQ.8.OR.ISUB.EQ.76.OR.ISUB.EQ.77.OR.ISUB.EQ.124)
155 & Q2SF=PMAS(24,1)**2
156 IF(ISUB.EQ.121.OR.ISUB.EQ.122) THEN
157 Q2SF=PMAS(KFPR(ISUBSV,2),1)**2
158 IF(MSTP(39).EQ.2) Q2SF=Q2SF+MAX(VINT(202),VINT(207))
159 IF(MSTP(39).EQ.3) Q2SF=SH
160 IF(MSTP(39).EQ.4) Q2SF=VINT(26)*VINT(2)
161 ENDIF
162 ENDIF
163 Q2PS=Q2SF
164 Q2SF=Q2SF*PARP(34)
165 IF(MSTP(22).GE.1.AND.(ISUB.EQ.10.OR.ISUB.EQ.83).AND.
166 &(MINT(43).EQ.2.OR.MINT(43).EQ.3)) THEN
167 XBJ=X(2)
168 IF(MINT(43).EQ.3) XBJ=X(1)
169 IF(MSTP(22).EQ.1) THEN
170 Q2PS=-TH
171 ELSEIF(MSTP(22).EQ.2) THEN
172 Q2PS=((1.-XBJ)/XBJ)*(-TH)
173 ELSEIF(MSTP(22).EQ.3) THEN
174 Q2PS=SQRT((1.-XBJ)/XBJ)*(-TH)
175 ELSE
176 Q2PS=(1.-XBJ)*MAX(1.,-LOG(XBJ))*(-TH)
177 ENDIF
178 ENDIF
179
180C...Store derived kinematical quantities.
181 VINT(41)=X(1)
182 VINT(42)=X(2)
183 VINT(44)=SH
184 VINT(43)=SQRT(SH)
185 VINT(45)=TH
186 VINT(46)=UH
187 VINT(48)=SQPTH
188 VINT(47)=SQRT(SQPTH)
189 VINT(50)=TAUP*VINT(2)
190 VINT(49)=SQRT(MAX(0.,VINT(50)))
191 VINT(52)=Q2
192 VINT(51)=SQRT(Q2)
193 VINT(54)=Q2SF
194 VINT(53)=SQRT(Q2SF)
195 VINT(56)=Q2PS
196 VINT(55)=SQRT(Q2PS)
197
198C...Calculate parton structure functions.
199 IF(ISTSB.LE.0) GOTO 160
200 IF(MINT(47).GE.2) THEN
201 DO 110 I=3-MIN(2,MINT(45)),MIN(2,MINT(46))
202 XSF=X(I)
203 IF(ISTSB.EQ.9) XSF=X(I)/VINT(142+I)
204 MINT(105)=MINT(102+I)
205 MINT(109)=MINT(106+I)
206 IF(MSTP(57).LE.1) THEN
207 CALL PYSTFU(MINT(10+I),XSF,Q2SF,XPQ)
208 ELSE
209 CALL PYSTFL(MINT(10+I),XSF,Q2SF,XPQ)
210 ENDIF
211 DO 100 KFL=-25,25
212 XSFX(I,KFL)=XPQ(KFL)
213 100 CONTINUE
214 110 CONTINUE
215 ENDIF
216
217C...Calculate alpha_em, alpha_strong and K-factor.
218 XW=PARU(102)
219 XWV=XW
220 IF(MSTP(8).GE.2.OR.(ISUB.GE.71.AND.ISUB.LE.77)) XW=
221 &1.-(PMAS(24,1)/PMAS(23,1))**2
222 XW1=1.-XW
223 XWC=1./(16.*XW*XW1)
224 AEM=ULALEM(Q2)
225 IF(MSTP(8).GE.1) AEM=SQRT(2.)*PARU(105)*PMAS(24,1)**2*XW/PARU(1)
226 IF(MSTP(33).NE.3) AS=ULALPS(PARP(34)*Q2)
227 FACK=1.
228 FACA=1.
229 IF(MSTP(33).EQ.1) THEN
230 FACK=PARP(31)
231 ELSEIF(MSTP(33).EQ.2) THEN
232 FACK=PARP(31)
233 FACA=PARP(32)/PARP(31)
234 ELSEIF(MSTP(33).EQ.3) THEN
235 Q2AS=PARP(33)*Q2
236 IF(ISTSB.EQ.9.AND.MSTP(82).GE.2) Q2AS=Q2AS+
237 & PARU(112)*PARP(82)
238 AS=ULALPS(Q2AS)
239 ENDIF
240 VINT(138)=1.
241 VINT(57)=AEM
242 VINT(58)=AS
243
244C...Set flags for allowed reacting partons/leptons.
245 DO 140 I=1,2
246 DO 120 J=-25,25
247 KFAC(I,J)=0
248 120 CONTINUE
249 IF(MINT(44+I).EQ.1) THEN
250 KFAC(I,MINT(10+I))=1
251 ELSEIF(MINT(40+I).EQ.1.AND.MSTP(12).EQ.0) THEN
252 KFAC(I,MINT(10+I))=1
253 KFAC(I,22)=1
254 KFAC(I,24)=1
255 KFAC(I,-24)=1
256 ELSE
257 DO 130 J=-25,25
258 KFAC(I,J)=KFIN(I,J)
259 IF(IABS(J).GT.MSTP(58).AND.IABS(J).LE.10) KFAC(I,J)=0
260 IF(XSFX(I,J).LT.1E-10) KFAC(I,J)=0
261 130 CONTINUE
262 ENDIF
263 140 CONTINUE
264
265C...Lower and upper limit for fermion flavour loops.
266 MMIN1=0
267 MMAX1=0
268 MMIN2=0
269 MMAX2=0
270 DO 150 J=-20,20
271 IF(KFAC(1,-J).EQ.1) MMIN1=-J
272 IF(KFAC(1,J).EQ.1) MMAX1=J
273 IF(KFAC(2,-J).EQ.1) MMIN2=-J
274 IF(KFAC(2,J).EQ.1) MMAX2=J
275 150 CONTINUE
276 MMINA=MIN(MMIN1,MMIN2)
277 MMAXA=MAX(MMAX1,MMAX2)
278
279C...Common conversion factors (including Jacobian) for subprocesses.
280 SQMZ=PMAS(23,1)**2
281 SQMW=PMAS(24,1)**2
282 SQMH=PMAS(KFHIGG,1)**2
283 GMMH=PMAS(KFHIGG,1)*PMAS(KFHIGG,2)
284 SQMZP=PMAS(32,1)**2
285 SQMWP=PMAS(34,1)**2
286 SQMHC=PMAS(37,1)**2
287 SQMLQ=PMAS(39,1)**2
288 SQMR=PMAS(40,1)**2
289
290C...Phase space integral in tau.
291 COMFAC=PARU(1)*PARU(5)/VINT(2)
292 IF(MINT(41).EQ.2.AND.MINT(42).EQ.2) COMFAC=COMFAC*FACK
293 IF((MINT(47).GE.2.OR.(ISTSB.GE.3.AND.ISTSB.LE.5)).AND.
294 &ISTSB.NE.9) THEN
295 ATAU1=LOG(TAUMAX/TAUMIN)
296 ATAU2=(TAUMAX-TAUMIN)/(TAUMAX*TAUMIN)
297 H1=COEF(ISUBSV,1)+(ATAU1/ATAU2)*COEF(ISUBSV,2)/TAU
298 IF(MINT(72).GE.1) THEN
299 TAUR1=VINT(73)
300 GAMR1=VINT(74)
301 ATAUD=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR1)/(TAUMAX+TAUR1))
302 ATAU3=ATAUD/TAUR1
303 IF(ATAUD.GT.1E-6) H1=H1+
304 & (ATAU1/ATAU3)*COEF(ISUBSV,3)/(TAU+TAUR1)
305 ATAUD=ATAN((TAUMAX-TAUR1)/GAMR1)-ATAN((TAUMIN-TAUR1)/GAMR1)
306 ATAU4=ATAUD/GAMR1
307 IF(ATAUD.GT.1E-6) H1=H1+
308 & (ATAU1/ATAU4)*COEF(ISUBSV,4)*TAU/((TAU-TAUR1)**2+GAMR1**2)
309 ENDIF
310 IF(MINT(72).EQ.2) THEN
311 TAUR2=VINT(75)
312 GAMR2=VINT(76)
313 ATAUD=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR2)/(TAUMAX+TAUR2))
314 ATAU5=ATAUD/TAUR2
315 IF(ATAUD.GT.1E-6) H1=H1+
316 & (ATAU1/ATAU5)*COEF(ISUBSV,5)/(TAU+TAUR2)
317 ATAUD=ATAN((TAUMAX-TAUR2)/GAMR2)-ATAN((TAUMIN-TAUR2)/GAMR2)
318 ATAU6=ATAUD/GAMR2
319 IF(ATAUD.GT.1E-6) H1=H1+
320 & (ATAU1/ATAU6)*COEF(ISUBSV,6)*TAU/((TAU-TAUR2)**2+GAMR2**2)
321 ENDIF
322 IF(MINT(47).EQ.5.AND.(ISTSB.LE.2.OR.ISTSB.GE.6)) THEN
323 ATAU7=LOG(MAX(2E-6,1.-TAUMIN)/MAX(2E-6,1.-TAUMAX))
324 IF(ATAU7.GT.1E-6) H1=H1+(ATAU1/ATAU7)*COEF(ISUBSV,7)*TAU/
325 & MAX(2E-6,1.-TAU)
326 ENDIF
327 COMFAC=COMFAC*ATAU1/(TAU*H1)
328 ENDIF
329
330C...Phase space integral in y*.
331 IF(MINT(47).GE.4.AND.ISTSB.NE.9) THEN
332 AYST0=YSTMAX-YSTMIN
333 IF(AYST0.LT.1E-6) THEN
334 COMFAC=0.
335 ELSE
336 AYST1=0.5*(YSTMAX-YSTMIN)**2
337 AYST2=AYST1
338 AYST3=2.*(ATAN(EXP(YSTMAX))-ATAN(EXP(YSTMIN)))
339 H2=(AYST0/AYST1)*COEF(ISUBSV,8)*(YST-YSTMIN)+
340 & (AYST0/AYST2)*COEF(ISUBSV,9)*(YSTMAX-YST)+
341 & (AYST0/AYST3)*COEF(ISUBSV,10)/COSH(YST)
342 IF(MINT(45).EQ.3) THEN
343 YST0=-0.5*LOG(TAUE)
344 AYST4=LOG(MAX(1E-6,EXP(YST0-YSTMIN)-1.)/
345 & MAX(1E-6,EXP(YST0-YSTMAX)-1.))
346 IF(AYST4.GT.1E-6) H2=H2+(AYST0/AYST4)*COEF(ISUBSV,11)/
347 & MAX(1E-6,1.-EXP(YST-YST0))
348 ENDIF
349 IF(MINT(46).EQ.3) THEN
350 YST0=-0.5*LOG(TAUE)
351 AYST5=LOG(MAX(1E-6,EXP(YST0+YSTMAX)-1.)/
352 & MAX(1E-6,EXP(YST0+YSTMIN)-1.))
353 IF(AYST5.GT.1E-6) H2=H2+(AYST0/AYST5)*COEF(ISUBSV,12)/
354 & MAX(1E-6,1.-EXP(-YST-YST0))
355 ENDIF
356 COMFAC=COMFAC*AYST0/H2
357 ENDIF
358 ENDIF
359
360C...2 -> 1 processes: reduction in angular part of phase space integral
361C...for case of decaying resonance.
362 ACTH0=CTNMAX-CTNMIN+CTPMAX-CTPMIN
363 IF((ISTSB.EQ.1.OR.ISTSB.EQ.3.OR.ISTSB.EQ.5)) THEN
364 IF(MDCY(KFPR(ISUBSV,1),1).EQ.1) THEN
365 IF(KFPR(ISUB,1).EQ.25.OR.KFPR(ISUB,1).EQ.37.OR.
366 & KFPR(ISUB,1).EQ.39) THEN
367 COMFAC=COMFAC*0.5*ACTH0
368 ELSE
369 COMFAC=COMFAC*0.125*(3.*ACTH0+CTNMAX**3-CTNMIN**3+
370 & CTPMAX**3-CTPMIN**3)
371 ENDIF
372 ENDIF
373
374C...2 -> 2 processes: angular part of phase space integral.
375 ELSEIF(ISTSB.EQ.2.OR.ISTSB.EQ.4.OR.ISTSB.EQ.6) THEN
376 ACTH1=LOG((MAX(RM34,RSQM-CTNMIN)*MAX(RM34,RSQM-CTPMIN))/
377 & (MAX(RM34,RSQM-CTNMAX)*MAX(RM34,RSQM-CTPMAX)))
378 ACTH2=LOG((MAX(RM34,RSQM+CTNMAX)*MAX(RM34,RSQM+CTPMAX))/
379 & (MAX(RM34,RSQM+CTNMIN)*MAX(RM34,RSQM+CTPMIN)))
380 ACTH3=1./MAX(RM34,RSQM-CTNMAX)-1./MAX(RM34,RSQM-CTNMIN)+
381 & 1./MAX(RM34,RSQM-CTPMAX)-1./MAX(RM34,RSQM-CTPMIN)
382 ACTH4=1./MAX(RM34,RSQM+CTNMIN)-1./MAX(RM34,RSQM+CTNMAX)+
383 & 1./MAX(RM34,RSQM+CTPMIN)-1./MAX(RM34,RSQM+CTPMAX)
384 H3=COEF(ISUBSV,13)+
385 & (ACTH0/ACTH1)*COEF(ISUBSV,14)/MAX(RM34,RSQM-CTH)+
386 & (ACTH0/ACTH2)*COEF(ISUBSV,15)/MAX(RM34,RSQM+CTH)+
387 & (ACTH0/ACTH3)*COEF(ISUBSV,16)/MAX(RM34,RSQM-CTH)**2+
388 & (ACTH0/ACTH4)*COEF(ISUBSV,17)/MAX(RM34,RSQM+CTH)**2
389 COMFAC=COMFAC*ACTH0*0.5*BE34/H3
390
391C...2 -> 2 processes: take into account final state Breit-Wigners.
392 COMFAC=COMFAC*VINT(80)
393 ENDIF
394
395C...2 -> 3, 4 processes: phace space integral in tau'.
396 IF(MINT(47).GE.2.AND.ISTSB.GE.3.AND.ISTSB.LE.5) THEN
397 ATAUP1=LOG(TAUPMX/TAUPMN)
398 ATAUP2=((1.-TAU/TAUPMX)**4-(1.-TAU/TAUPMN)**4)/(4.*TAU)
399 H4=COEF(ISUBSV,18)+
400 & (ATAUP1/ATAUP2)*COEF(ISUBSV,19)*(1.-TAU/TAUP)**3/TAUP
401 IF(MINT(47).EQ.5) THEN
402 ATAUP3=LOG(MAX(2E-6,1.-TAUPMN)/MAX(2E-6,1.-TAUPMX))
403 H4=H4+(ATAUP1/ATAUP3)*COEF(ISUBSV,20)*TAUP/MAX(2E-6,1.-TAUP)
404 ENDIF
405 COMFAC=COMFAC*ATAUP1/H4
406 ENDIF
407
408C...2 -> 3, 4 processes: effective W/Z structure functions.
409 IF(ISTSB.EQ.3.OR.ISTSB.EQ.4) THEN
410 IF(1.-TAU/TAUP.GT.1.E-4) THEN
411 FZW=(1.+TAU/TAUP)*LOG(TAUP/TAU)-2.*(1.-TAU/TAUP)
412 ELSE
413 FZW=1./6.*(1.-TAU/TAUP)**3*TAU/TAUP
414 ENDIF
415 COMFAC=COMFAC*FZW
416 ENDIF
417
418C...2 -> 3 processes: phase space integrals for pT1, pT2, y3, mirror.
419 IF(ISTSB.EQ.5) THEN
420 COMFAC=COMFAC*VINT(205)*VINT(210)*VINT(212)*VINT(214)/
421 & (128.*PARU(1)**4*VINT(220))*(TAU**2/TAUP)
422 ENDIF
423
424C...2 -> 2 processes: optional dampening by pT^4/(pT0^2+pT^2)^2.
425 IF(MSTP(85).EQ.1.AND.MOD(ISTSB,2).EQ.0) COMFAC=COMFAC*
426 &SQPTH**2/(PARP(82)**2+SQPTH)**2
427
428C...gamma + gamma: include factor 2 when different nature.
429 IF(MINT(11).EQ.22.AND.MINT(12).EQ.22.AND.MINT(123).GE.4)
430 &COMFAC=2.*COMFAC
431
432C...Phase space integral for low-pT and multiple interactions.
433 IF(ISTSB.EQ.9) THEN
434 COMFAC=PARU(1)*PARU(5)*FACK*0.5*VINT(2)/SH2
435 ATAU1=LOG(2.*(1.+SQRT(1.-XT2))/XT2-1.)
436 ATAU2=2.*ATAN(1./XT2-1.)/SQRT(XT2)
437 H1=COEF(ISUBSV,1)+(ATAU1/ATAU2)*COEF(ISUBSV,2)/SQRT(TAU)
438 COMFAC=COMFAC*ATAU1/H1
439 AYST0=YSTMAX-YSTMIN
440 AYST1=0.5*(YSTMAX-YSTMIN)**2
441 AYST3=2.*(ATAN(EXP(YSTMAX))-ATAN(EXP(YSTMIN)))
442 H2=(AYST0/AYST1)*COEF(ISUBSV,8)*(YST-YSTMIN)+
443 & (AYST0/AYST1)*COEF(ISUBSV,9)*(YSTMAX-YST)+
444 & (AYST0/AYST3)*COEF(ISUBSV,10)/COSH(YST)
445 COMFAC=COMFAC*AYST0/H2
446 IF(MSTP(82).LE.1) COMFAC=COMFAC*XT2**2*(1./VINT(149)-1.)
447C...For MSTP(82)>=2 an additional factor (xT2/(xT2+VINT(149))**2 is
448C...introduced to make cross-section finite for xT2 -> 0.
449 IF(MSTP(82).GE.2) COMFAC=COMFAC*XT2**2/(VINT(149)*
450 & (1.+VINT(149)))
451 ENDIF
452
453C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron.
454 IF((MSTP(46).GE.3.AND.MSTP(46).LE.6).AND.(ISUB.EQ.71.OR.ISUB.EQ.
455 &72.OR.ISUB.EQ.73.OR.ISUB.EQ.76.OR.ISUB.EQ.77)) THEN
456C...Calculate M_R and N_R functions for Higgs-like and QCD-like models.
457 IF(MSTP(46).LE.4) THEN
458 HDTLH=LOG(PMAS(25,1)/PARP(44))
459 HDTMR=(4.5*PARU(1)/SQRT(3.)-74./9.)/8.+HDTLH/12.
460 HDTNR=-1./18.+HDTLH/6.
461 ELSE
462 HDTNM=0.125*(1./(288.*PARU(1)**2)+(PARP(47)/PARP(45))**2)
463 HDTLQ=LOG(PARP(45)/PARP(44))
464 HDTMR=-(4.*PARU(1))**2*0.5*HDTNM+HDTLQ/12.
465 HDTNR=(4.*PARU(1))**2*HDTNM+HDTLQ/6.
466 ENDIF
467
468C...Calculate lowest and next-to-lowest order partial wave amplitudes.
469 HDTV=1./(16.*PARU(1)*PARP(47)**2)
470 A00L=HDTV*SH
471 A20L=-0.5*A00L
472 A11L=A00L/6.
473 HDTLS=LOG(SH/PARP(44)**2)
474 A004=(HDTV*SH)**2/(4.*PARU(1))*CMPLX((176.*HDTMR+112.*HDTNR)/3.+
475 & 11./27.-(50./9.)*HDTLS,4.*PARU(1))
476 A204=(HDTV*SH)**2/(4.*PARU(1))*CMPLX(32.*(HDTMR+2.*HDTNR)/3.+
477 & 25./54.-(20./9.)*HDTLS,PARU(1))
478 A114=(HDTV*SH)**2/(6.*PARU(1))*CMPLX(4.*(-2.*HDTMR+HDTNR)-
479 & 1./18.,PARU(1)/6.)
480
481C...Unitarize partial wave amplitudes with Pade or K-matrix method.
482 IF(MSTP(46).EQ.3.OR.MSTP(46).EQ.5) THEN
483 A00U=A00L/(1.-A004/A00L)
484 A20U=A20L/(1.-A204/A20L)
485 A11U=A11L/(1.-A114/A11L)
486 ELSE
487 A00U=(A00L+REAL(A004))/(1.-CMPLX(0.,A00L+REAL(A004)))
488 A20U=(A20L+REAL(A204))/(1.-CMPLX(0.,A20L+REAL(A204)))
489 A11U=(A11L+REAL(A114))/(1.-CMPLX(0.,A11L+REAL(A114)))
490 ENDIF
491 ENDIF
492
493C...A: 2 -> 1, tree diagrams.
494
495 160 IF(ISUB.LE.10) THEN
496 IF(ISUB.EQ.1) THEN
497C...f + f~ -> gamma*/Z0.
498 MINT(61)=2
499 CALL PYWIDT(23,SH,WDTP,WDTE)
500 HP0=AEM/3.*SH
501 HP1=AEM/3.*XWC*SH
502 HS=HP1*WDTP(0)
503 FACZ=4.*COMFAC*3.
504 DO 170 I=MMINA,MMAXA
505 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 170
506 EI=KCHG(IABS(I),1)/3.
507 AI=SIGN(1.,EI)
508 VI=AI-4.*EI*XWV
509 HI0=HP0
510 IF(IABS(I).LE.10) HI0=HI0*FACA/3.
511 HI1=HP1
512 IF(IABS(I).LE.10) HI1=HI1*FACA/3.
513 NCHN=NCHN+1
514 ISIG(NCHN,1)=I
515 ISIG(NCHN,2)=-I
516 ISIG(NCHN,3)=1
517 SIGH(NCHN)=FACZ*(EI**2/SH2*HI0*HP0*VINT(111)+EI*VI*(1.-SQMZ/SH)/
518 & ((SH-SQMZ)**2+HS**2)*(HI0*HP1+HI1*HP0)*VINT(112)+
519 & (VI**2+AI**2)/((SH-SQMZ)**2+HS**2)*HI1*HP1*VINT(114))
520 170 CONTINUE
521
522 ELSEIF(ISUB.EQ.2) THEN
523C...f + f~' -> W+/-.
524 CALL PYWIDT(24,SH,WDTP,WDTE)
525 HP=AEM/(24.*XW)*SH
526 HS=HP*WDTP(0)
527 FACBW=4.*COMFAC/((SH-SQMW)**2+HS**2)*3.
528 DO 190 I=MMIN1,MMAX1
529 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 190
530 IA=IABS(I)
531 DO 180 J=MMIN2,MMAX2
532 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 180
533 JA=IABS(J)
534 IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 180
535 IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) GOTO 180
536 KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
537 HI=HP*2.
538 IF(IA.LE.10) HI=HI*VCKM((IA+1)/2,(JA+1)/2)*FACA/3.
539 NCHN=NCHN+1
540 ISIG(NCHN,1)=I
541 ISIG(NCHN,2)=J
542 ISIG(NCHN,3)=1
543 HF=HP*(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))
544 SIGH(NCHN)=HI*FACBW*HF
545 180 CONTINUE
546 190 CONTINUE
547
548 ELSEIF(ISUB.EQ.3) THEN
549C...f + f~ -> H0 (or H'0, or A0).
550 CALL PYWIDT(KFHIGG,SH,WDTP,WDTE)
551 HP=AEM/(8.*XW)*SH/SQMW*SH
552 HS=HP*WDTP(0)
553 HF=HP*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
554 FACBW=4.*COMFAC/((SH-SQMH)**2+HS**2)
555 IF(ABS(SH-SQMH).GT.100.*HS) FACBW=0.
556 DO 200 I=MMINA,MMAXA
557 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 200
558 IA=IABS(I)
559 RMQ=PMAS(IA,1)**2/SH
560 HI=HP*RMQ
561 IF(IA.LE.10) HI=HP*RMQ*FACA/3.
562 IF(IA.LE.10.AND.MSTP(37).EQ.1.AND.MSTP(2).GE.1) HI=HI*
563 & (LOG(MAX(4.,PARP(37)**2*RMQ*SH/PARU(117)**2))/
564 & LOG(MAX(4.,SH/PARU(117)**2)))**(24./(33.-2.*MSTU(118)))
565 IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN
566 IKFI=1
567 IF(IA.LE.10.AND.MOD(IA,2).EQ.0) IKFI=2
568 IF(IA.GT.10) IKFI=3
569 HI=HI*PARU(150+10*IHIGG+IKFI)**2
570 ENDIF
571 NCHN=NCHN+1
572 ISIG(NCHN,1)=I
573 ISIG(NCHN,2)=-I
574 ISIG(NCHN,3)=1
575 SIGH(NCHN)=HI*FACBW*HF
576 200 CONTINUE
577
578 ELSEIF(ISUB.EQ.4) THEN
579C...gamma + W+/- -> W+/-.
580
581 ELSEIF(ISUB.EQ.5) THEN
582C...Z0 + Z0 -> H0.
583 CALL PYWIDT(25,SH,WDTP,WDTE)
584 HP=AEM/(8.*XW)*SH/SQMW*SH
585 HS=HP*WDTP(0)
586 HF=HP*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
587 FACBW=4.*COMFAC/((SH-SQMH)**2+HS**2)
588 IF(ABS(SH-SQMH).GT.100.*HS) FACBW=0.
589 HI=HP/4.
590 FACI=8./(PARU(1)**2*XW1)*(AEM*XWC)**2
591 DO 220 I=MMIN1,MMAX1
592 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 220
593 DO 210 J=MMIN2,MMAX2
594 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 210
595 EI=KCHG(IABS(I),1)/3.
596 AI=SIGN(1.,EI)
597 VI=AI-4.*EI*XWV
598 EJ=KCHG(IABS(J),1)/3.
599 AJ=SIGN(1.,EJ)
600 VJ=AJ-4.*EJ*XWV
601 NCHN=NCHN+1
602 ISIG(NCHN,1)=I
603 ISIG(NCHN,2)=J
604 ISIG(NCHN,3)=1
605 SIGH(NCHN)=FACI*(VI**2+AI**2)*(VJ**2+AJ**2)*HI*FACBW*HF
606 210 CONTINUE
607 220 CONTINUE
608
609 ELSEIF(ISUB.EQ.6) THEN
610C...Z0 + W+/- -> W+/-.
611
612 ELSEIF(ISUB.EQ.7) THEN
613C...W+ + W- -> Z0.
614
615 ELSEIF(ISUB.EQ.8) THEN
616C...W+ + W- -> H0.
617 CALL PYWIDT(25,SH,WDTP,WDTE)
618 HP=AEM/(8.*XW)*SH/SQMW*SH
619 HS=HP*WDTP(0)
620 HF=HP*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
621 FACBW=4.*COMFAC/((SH-SQMH)**2+HS**2)
622 IF(ABS(SH-SQMH).GT.100.*HS) FACBW=0.
623 HI=HP/2.
624 FACI=1./(4.*PARU(1)**2)*(AEM/XW)**2
625 DO 240 I=MMIN1,MMAX1
626 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 240
627 EI=SIGN(1.,FLOAT(I))*KCHG(IABS(I),1)
628 DO 230 J=MMIN2,MMAX2
629 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 230
630 EJ=SIGN(1.,FLOAT(J))*KCHG(IABS(J),1)
631 IF(EI*EJ.GT.0.) GOTO 230
632 NCHN=NCHN+1
633 ISIG(NCHN,1)=I
634 ISIG(NCHN,2)=J
635 ISIG(NCHN,3)=1
636 SIGH(NCHN)=FACI*VINT(180+I)*VINT(180+J)*HI*FACBW*HF
637 230 CONTINUE
638 240 CONTINUE
639
640C...B: 2 -> 2, tree diagrams.
641
642 ELSEIF(ISUB.EQ.10) THEN
643C...f + f' -> f + f' (gamma/Z/W exchange).
644 FACGGF=COMFAC*AEM**2*2.*(SH2+UH2)/TH2
645 FACGZF=COMFAC*AEM**2*XWC*4.*SH2/(TH*(TH-SQMZ))
646 FACZZF=COMFAC*(AEM*XWC)**2*2.*SH2/(TH-SQMZ)**2
647 FACWWF=COMFAC*(0.5*AEM/XW)**2*SH2/(TH-SQMW)**2
648 DO 260 I=MMIN1,MMAX1
649 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 260
650 IA=IABS(I)
651 DO 250 J=MMIN2,MMAX2
652 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 250
653 JA=IABS(J)
654C...Electroweak couplings.
655 EI=KCHG(IA,1)*ISIGN(1,I)/3.
656 AI=SIGN(1.,KCHG(IA,1)+0.5)*ISIGN(1,I)
657 VI=AI-4.*EI*XWV
658 EJ=KCHG(JA,1)*ISIGN(1,J)/3.
659 AJ=SIGN(1.,KCHG(JA,1)+0.5)*ISIGN(1,J)
660 VJ=AJ-4.*EJ*XWV
661 EPSIJ=ISIGN(1,I*J)
662C...gamma/Z exchange, only gamma exchange, or only Z exchange.
663 IF(MSTP(21).GE.1.AND.MSTP(21).LE.4) THEN
664 IF(MSTP(21).EQ.1.OR.MSTP(21).EQ.4) THEN
665 FACNCF=FACGGF*EI**2*EJ**2+FACGZF*EI*EJ*
666 & (VI*VJ*(1.+UH2/SH2)+AI*AJ*EPSIJ*(1.-UH2/SH2))+
667 & FACZZF*((VI**2+AI**2)*(VJ**2+AJ**2)*(1.+UH2/SH2)+
668 & 4.*VI*VJ*AI*AJ*EPSIJ*(1.-UH2/SH2))
669 ELSEIF(MSTP(21).EQ.2) THEN
670 FACNCF=FACGGF*EI**2*EJ**2
671 ELSE
672 FACNCF=FACZZF*((VI**2+AI**2)*(VJ**2+AJ**2)*(1.+UH2/SH2)+
673 & 4.*VI*VJ*AI*AJ*EPSIJ*(1.-UH2/SH2))
674 ENDIF
675 NCHN=NCHN+1
676 ISIG(NCHN,1)=I
677 ISIG(NCHN,2)=J
678 ISIG(NCHN,3)=1
679 SIGH(NCHN)=FACNCF
680 ENDIF
681C...W exchange.
682 IF((MSTP(21).EQ.1.OR.MSTP(21).EQ.5).AND.AI*AJ.LT.0.) THEN
683 FACCCF=FACWWF*VINT(180+I)*VINT(180+J)
684 IF(EPSIJ.LT.0.) FACCCF=FACCCF*UH2/SH2
685 IF(IA.GT.10.AND.MOD(IA,2).EQ.0) FACCCF=2.*FACCCF
686 IF(JA.GT.10.AND.MOD(JA,2).EQ.0) FACCCF=2.*FACCCF
687 NCHN=NCHN+1
688 ISIG(NCHN,1)=I
689 ISIG(NCHN,2)=J
690 ISIG(NCHN,3)=2
691 SIGH(NCHN)=FACCCF
692 ENDIF
693 250 CONTINUE
694 260 CONTINUE
695 ENDIF
696
697 ELSEIF(ISUB.LE.20) THEN
698 IF(ISUB.EQ.11) THEN
699C...f + f' -> f + f' (g exchange).
700 FACQQ1=COMFAC*AS**2*4./9.*(SH2+UH2)/TH2
701 FACQQB=COMFAC*AS**2*4./9.*((SH2+UH2)/TH2*FACA-
702 & MSTP(34)*2./3.*UH2/(SH*TH))
703 FACQQ2=COMFAC*AS**2*4./9.*((SH2+TH2)/UH2-
704 & MSTP(34)*2./3.*SH2/(TH*UH))
705 IF(MSTP(5).GE.1) THEN
706C...Modifications from contact interactions (compositeness).
707 FACCI1=FACQQ1+COMFAC*(SH2/PARU(155)**4)
708 FACCIB=FACQQB+COMFAC*(8./9.)*(AS*PARU(156)/PARU(155)**2)*
709 & (UH2/TH+UH2/SH)+COMFAC*(5./3.)*(UH2/PARU(155)**4)
710 FACCI2=FACQQ2+COMFAC*(8./9.)*(AS*PARU(156)/PARU(155)**2)*
711 & (SH2/TH+SH2/UH)+COMFAC*(5./3.)*(SH2/PARU(155)**4)
712 FACCI3=FACQQ1+COMFAC*(UH2/PARU(155)**4)
713 ENDIF
714 DO 280 I=MMIN1,MMAX1
715 IA=IABS(I)
716 IF(I.EQ.0.OR.IA.GT.MSTP(58).OR.KFAC(1,I).EQ.0) GOTO 280
717 DO 270 J=MMIN2,MMAX2
718 JA=IABS(J)
719 IF(J.EQ.0.OR.JA.GT.MSTP(58).OR.KFAC(2,J).EQ.0) GOTO 270
720 NCHN=NCHN+1
721 ISIG(NCHN,1)=I
722 ISIG(NCHN,2)=J
723 ISIG(NCHN,3)=1
724 IF(MSTP(5).LE.0.OR.(MSTP(5).EQ.1.AND.(IA.GE.3.OR.JA.GE.3)))
725 & THEN
726 SIGH(NCHN)=FACQQ1
727 IF(I.EQ.-J) SIGH(NCHN)=FACQQB
728 ELSE
729 SIGH(NCHN)=FACCI1
730 IF(I*J.LT.0) SIGH(NCHN)=FACCI3
731 IF(I.EQ.-J) SIGH(NCHN)=FACCIB
732 ENDIF
733 IF(I.EQ.J) THEN
734 SIGH(NCHN)=0.5*SIGH(NCHN)
735 NCHN=NCHN+1
736 ISIG(NCHN,1)=I
737 ISIG(NCHN,2)=J
738 ISIG(NCHN,3)=2
739 IF(MSTP(5).LE.0.OR.(MSTP(5).EQ.1.AND.IA.GE.3)) THEN
740 SIGH(NCHN)=0.5*FACQQ2
741 ELSE
742 SIGH(NCHN)=0.5*FACCI2
743 ENDIF
744 ENDIF
745 270 CONTINUE
746 280 CONTINUE
747
748 ELSEIF(ISUB.EQ.12) THEN
749C...f + f~ -> f' + f~' (q + q~ -> q' + q~' only).
750 CALL PYWIDT(21,SH,WDTP,WDTE)
751 FACQQB=COMFAC*AS**2*4./9.*(TH2+UH2)/SH2*(WDTE(0,1)+WDTE(0,2)+
752 & WDTE(0,4))
753 IF(MSTP(5).EQ.1) THEN
754C...Modifications from contact interactions (compositeness).
755 FACCIB=FACQQB
756 DO 290 I=1,2
757 FACCIB=FACCIB+COMFAC*(UH2/PARU(155)**4)*(WDTE(I,1)+WDTE(I,2)+
758 & WDTE(I,4))
759 290 CONTINUE
760 ELSEIF(MSTP(5).GE.2) THEN
761 FACCIB=FACQQB+COMFAC*(UH2/PARU(155)**4)*(WDTE(0,1)+WDTE(0,2)+
762 & WDTE(0,4))
763 ENDIF
764 DO 300 I=MMINA,MMAXA
765 IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
766 & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 300
767 NCHN=NCHN+1
768 ISIG(NCHN,1)=I
769 ISIG(NCHN,2)=-I
770 ISIG(NCHN,3)=1
771 IF(MSTP(5).LE.0.OR.(MSTP(5).EQ.1.AND.IABS(I).GE.3)) THEN
772 SIGH(NCHN)=FACQQB
773 ELSE
774 SIGH(NCHN)=FACCIB
775 ENDIF
776 300 CONTINUE
777
778 ELSEIF(ISUB.EQ.13) THEN
779C...f + f~ -> g + g (q + q~ -> g + g only).
780 FACGG1=COMFAC*AS**2*32./27.*(UH/TH-(2.+MSTP(34)*1./4.)*UH2/SH2)
781 FACGG2=COMFAC*AS**2*32./27.*(TH/UH-(2.+MSTP(34)*1./4.)*TH2/SH2)
782 DO 310 I=MMINA,MMAXA
783 IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
784 & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 310
785 NCHN=NCHN+1
786 ISIG(NCHN,1)=I
787 ISIG(NCHN,2)=-I
788 ISIG(NCHN,3)=1
789 SIGH(NCHN)=0.5*FACGG1
790 NCHN=NCHN+1
791 ISIG(NCHN,1)=I
792 ISIG(NCHN,2)=-I
793 ISIG(NCHN,3)=2
794 SIGH(NCHN)=0.5*FACGG2
795 310 CONTINUE
796
797 ELSEIF(ISUB.EQ.14) THEN
798C...f + f~ -> g + gamma (q + q~ -> g + gamma only).
799 FACGG=COMFAC*AS*AEM*8./9.*(TH2+UH2)/(TH*UH)
800 DO 320 I=MMINA,MMAXA
801 IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
802 & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 320
803 EI=KCHG(IABS(I),1)/3.
804 NCHN=NCHN+1
805 ISIG(NCHN,1)=I
806 ISIG(NCHN,2)=-I
807 ISIG(NCHN,3)=1
808 SIGH(NCHN)=FACGG*EI**2
809 320 CONTINUE
810
811 ELSEIF(ISUB.EQ.15) THEN
812C...f + f~ -> g + (gamma*/Z0) (q + q~ -> g + (gamma*/Z0) only).
813 FACZG=COMFAC*AS*AEM*(8./9.)*(TH2+UH2+2.*SQM4*SH)/(TH*UH)
814C...gamma, gamma/Z interference and Z couplings to final fermion pairs.
815 HFGG=0.
816 HFGZ=0.
817 HFZZ=0.
818 HBW4=0.
819 RADC4=1.+ULALPS(SQM4)/PARU(1)
820 DO 330 I=1,MIN(16,MDCY(23,3))
821 IDC=I+MDCY(23,2)-1
822 IF(MDME(IDC,1).LT.0) GOTO 330
823 IMDM=0
824 IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2.OR.MDME(IDC,1).EQ.4)
825 & IMDM=1
826 IF(I.LE.8) THEN
827 EF=KCHG(I,1)/3.
828 AF=SIGN(1.,EF+0.1)
829 VF=AF-4.*EF*XWV
830 ELSEIF(I.LE.16) THEN
831 EF=KCHG(I+2,1)/3.
832 AF=SIGN(1.,EF+0.1)
833 VF=AF-4.*EF*XWV
834 ENDIF
835 RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4
836 IF(4.*RM1.LT.1.) THEN
837 FCOF=1.
838 IF(I.LE.8) FCOF=3.*RADC4
839 BE34=SQRT(MAX(0.,1.-4.*RM1))
840 IF(IMDM.EQ.1) THEN
841 HFGG=HFGG+FCOF*EF**2*(1.+2.*RM1)*BE34
842 HFGZ=HFGZ+FCOF*EF*VF*(1.+2.*RM1)*BE34
843 HFZZ=HFZZ+FCOF*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*BE34
844 ENDIF
845 HBW4=HBW4+FCOF*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*BE34
846 ENDIF
847 330 CONTINUE
848C...Propagators: as simulated in PYOFSH and as desired.
849 GMMZ=PMAS(23,1)*PMAS(23,2)
850 HBW4=HBW4*XWC*SQMZ/((SQM4-SQMZ)**2+GMMZ**2)
851 MINT(15)=1
852 MINT(61)=1
853 CALL PYWIDT(23,SQM4,WDTP,WDTE)
854 HFGG=HFGG*VINT(111)/SQM4
855 HFGZ=HFGZ*VINT(112)/SQM4
856 HFZZ=HFZZ*VINT(114)/SQM4
857C...Loop over flavours; consider full gamma/Z structure.
858 DO 340 I=MMINA,MMAXA
859 IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
860 & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 340
861 EI=KCHG(IABS(I),1)/3.
862 AI=SIGN(1.,EI)
863 VI=AI-4.*EI*XWV
864 NCHN=NCHN+1
865 ISIG(NCHN,1)=I
866 ISIG(NCHN,2)=-I
867 ISIG(NCHN,3)=1
868 SIGH(NCHN)=FACZG*(EI**2*HFGG+EI*VI*HFGZ+
869 & (VI**2+AI**2)*HFZZ)/HBW4
870 340 CONTINUE
871
872 ELSEIF(ISUB.EQ.16) THEN
873C...f + f~' -> g + W+/- (q + q~' -> g + W+/- only).
874 FACWG=COMFAC*AS*AEM/XW*2./9.*(TH2+UH2+2.*SQM4*SH)/(TH*UH)
875C...Propagators: as simulated in PYOFSH and as desired.
876 GMMW=PMAS(24,1)*PMAS(24,2)
877 HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2)
878 CALL PYWIDT(24,SQM4,WDTP,WDTE)
879 AEMC=ULALEM(SQM4)
880 IF(MSTP(8).GE.1) AEMC=AEM
881 GMMWC=SQM4*WDTP(0)*AEMC/(24.*XW)
882 HBW4C=GMMWC/((SQM4-SQMW)**2+GMMWC**2)
883 FACWG=FACWG*HBW4C/HBW4
884 DO 360 I=MMIN1,MMAX1
885 IA=IABS(I)
886 IF(I.EQ.0.OR.IA.GT.10.OR.KFAC(1,I).EQ.0) GOTO 360
887 DO 350 J=MMIN2,MMAX2
888 JA=IABS(J)
889 IF(J.EQ.0.OR.JA.GT.10.OR.KFAC(2,J).EQ.0) GOTO 350
890 IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 350
891 KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
892 WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))/WDTP(0)
893 FCKM=VCKM((IA+1)/2,(JA+1)/2)
894 NCHN=NCHN+1
895 ISIG(NCHN,1)=I
896 ISIG(NCHN,2)=J
897 ISIG(NCHN,3)=1
898 SIGH(NCHN)=FACWG*FCKM*WIDSC
899 350 CONTINUE
900 360 CONTINUE
901
902 ELSEIF(ISUB.EQ.17) THEN
903C...f + f~ -> g + H0 (q + q~ -> g + H0 only).
904
905 ELSEIF(ISUB.EQ.18) THEN
906C...f + f~ -> gamma + gamma.
907 FACGG=COMFAC*AEM**2*2.*(TH2+UH2)/(TH*UH)
908 DO 370 I=MMINA,MMAXA
909 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 370
910 EI=KCHG(IABS(I),1)/3.
911 FCOI=1.
912 IF(IABS(I).LE.10) FCOI=FACA/3.
913 NCHN=NCHN+1
914 ISIG(NCHN,1)=I
915 ISIG(NCHN,2)=-I
916 ISIG(NCHN,3)=1
917 SIGH(NCHN)=0.5*FACGG*FCOI*EI**4
918 370 CONTINUE
919
920 ELSEIF(ISUB.EQ.19) THEN
921C...f + f~ -> gamma + (gamma*/Z0).
922 FACGZ=COMFAC*2.*AEM**2*(TH2+UH2+2.*SQM4*SH)/(TH*UH)
923C...gamma, gamma/Z interference and Z couplings to final fermion pairs.
924 HFGG=0.
925 HFGZ=0.
926 HFZZ=0.
927 HBW4=0.
928 RADC4=1.+ULALPS(SQM4)/PARU(1)
929 DO 380 I=1,MIN(16,MDCY(23,3))
930 IDC=I+MDCY(23,2)-1
931 IF(MDME(IDC,1).LT.0) GOTO 380
932 IMDM=0
933 IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2.OR.MDME(IDC,1).EQ.4)
934 & IMDM=1
935 IF(I.LE.8) THEN
936 EF=KCHG(I,1)/3.
937 AF=SIGN(1.,EF+0.1)
938 VF=AF-4.*EF*XWV
939 ELSEIF(I.LE.16) THEN
940 EF=KCHG(I+2,1)/3.
941 AF=SIGN(1.,EF+0.1)
942 VF=AF-4.*EF*XWV
943 ENDIF
944 RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4
945 IF(4.*RM1.LT.1.) THEN
946 FCOF=1.
947 IF(I.LE.8) FCOF=3.*RADC4
948 BE34=SQRT(MAX(0.,1.-4.*RM1))
949 IF(IMDM.EQ.1) THEN
950 HFGG=HFGG+FCOF*EF**2*(1.+2.*RM1)*BE34
951 HFGZ=HFGZ+FCOF*EF*VF*(1.+2.*RM1)*BE34
952 HFZZ=HFZZ+FCOF*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*BE34
953 ENDIF
954 HBW4=HBW4+FCOF*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*BE34
955 ENDIF
956 380 CONTINUE
957C...Propagators: as simulated in PYOFSH and as desired.
958 GMMZ=PMAS(23,1)*PMAS(23,2)
959 HBW4=HBW4*XWC*SQMZ/((SQM4-SQMZ)**2+GMMZ**2)
960 MINT(15)=1
961 MINT(61)=1
962 CALL PYWIDT(23,SQM4,WDTP,WDTE)
963 HFGG=HFGG*VINT(111)/SQM4
964 HFGZ=HFGZ*VINT(112)/SQM4
965 HFZZ=HFZZ*VINT(114)/SQM4
966C...Loop over flavours; consider full gamma/Z structure.
967 DO 390 I=MMINA,MMAXA
968 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 390
969 EI=KCHG(IABS(I),1)/3.
970 AI=SIGN(1.,EI)
971 VI=AI-4.*EI*XWV
972 FCOI=1.
973 IF(IABS(I).LE.10) FCOI=FACA/3.
974 NCHN=NCHN+1
975 ISIG(NCHN,1)=I
976 ISIG(NCHN,2)=-I
977 ISIG(NCHN,3)=1
978 SIGH(NCHN)=FACGZ*FCOI*EI**2*(EI**2*HFGG+EI*VI*HFGZ+
979 & (VI**2+AI**2)*HFZZ)/HBW4
980 390 CONTINUE
981
982 ELSEIF(ISUB.EQ.20) THEN
983C...f + f~' -> gamma + W+/-.
984 FACGW=COMFAC*0.5*AEM**2/XW
985C...Propagators: as simulated in PYOFSH and as desired.
986 GMMW=PMAS(24,1)*PMAS(24,2)
987 HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2)
988 CALL PYWIDT(24,SQM4,WDTP,WDTE)
989 AEMC=ULALEM(SQM4)
990 IF(MSTP(8).GE.1) AEMC=AEM
991 GMMWC=SQM4*WDTP(0)*AEMC/(24.*XW)
992 HBW4C=GMMWC/((SQM4-SQMW)**2+GMMWC**2)
993 FACGW=FACGW*HBW4C/HBW4
994C...Anomalous couplings.
995 TERM1=(TH2+UH2+2.*SQM4*SH)/(TH*UH)
996 TERM2=0.
997 TERM3=0.
998 IF(MSTP(5).GE.1) THEN
999 TERM2=PARU(153)*(TH-UH)/(TH+UH)
1000 TERM3=0.5*PARU(153)**2*(TH*UH+(TH2+UH2)*SH/
1001 & (4.*PMAS(24,1)**2))/(TH+UH)**2
1002 ENDIF
1003 DO 410 I=MMIN1,MMAX1
1004 IA=IABS(I)
1005 IF(I.EQ.0.OR.IA.GT.20.OR.KFAC(1,I).EQ.0) GOTO 410
1006 DO 400 J=MMIN2,MMAX2
1007 JA=IABS(J)
1008 IF(J.EQ.0.OR.JA.GT.20.OR.KFAC(2,J).EQ.0) GOTO 400
1009 IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 400
1010 IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) GOTO 400
1011 KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
1012 WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))/WDTP(0)
1013 IF(IA.LE.10) THEN
1014 FACWR=UH/(TH+UH)-1./3.
1015 FCKM=VCKM((IA+1)/2,(JA+1)/2)
1016 FCOI=FACA/3.
1017 ELSE
1018 FACWR=-TH/(TH+UH)
1019 FCKM=1.
1020 FCOI=1.
1021 ENDIF
1022 FACWK=TERM1*FACWR**2+TERM2*FACWR+TERM3
1023 NCHN=NCHN+1
1024 ISIG(NCHN,1)=I
1025 ISIG(NCHN,2)=J
1026 ISIG(NCHN,3)=1
1027 SIGH(NCHN)=FACGW*FACWK*FCOI*FCKM*WIDSC
1028 400 CONTINUE
1029 410 CONTINUE
1030 ENDIF
1031
1032 ELSEIF(ISUB.LE.30) THEN
1033 IF(ISUB.EQ.21) THEN
1034C...f + f~ -> gamma + H0.
1035
1036 ELSEIF(ISUB.EQ.22) THEN
1037C...f + f~ -> (gamma*/Z0) + (gamma*/Z0).
1038C...Kinematics dependence.
1039 FACZZ=COMFAC*AEM**2*((TH2+UH2+2.*(SQM3+SQM4)*SH)/(TH*UH)-
1040 & SQM3*SQM4*(1./TH2+1./UH2))
1041C...gamma, gamma/Z interference and Z couplings to final fermion pairs.
1042 DO 430 I=1,6
1043 DO 420 J=1,3
1044 HGZ(I,J)=0.
1045 420 CONTINUE
1046 430 CONTINUE
1047 HBW3=0.
1048 HBW4=0.
1049 RADC3=1.+ULALPS(SQM3)/PARU(1)
1050 RADC4=1.+ULALPS(SQM4)/PARU(1)
1051 DO 440 I=1,MIN(16,MDCY(23,3))
1052 IDC=I+MDCY(23,2)-1
1053 IF(MDME(IDC,1).LT.0) GOTO 440
1054 IMDM=0
1055 IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2) IMDM=1
1056 IF(MDME(IDC,1).EQ.4.OR.MDME(IDC,1).EQ.5) IMDM=MDME(IDC,1)-2
1057 IF(I.LE.8) THEN
1058 EF=KCHG(I,1)/3.
1059 AF=SIGN(1.,EF+0.1)
1060 VF=AF-4.*EF*XWV
1061 ELSEIF(I.LE.16) THEN
1062 EF=KCHG(I+2,1)/3.
1063 AF=SIGN(1.,EF+0.1)
1064 VF=AF-4.*EF*XWV
1065 ENDIF
1066 RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM3
1067 IF(4.*RM1.LT.1.) THEN
1068 FCOF=1.
1069 IF(I.LE.8) FCOF=3.*RADC3
1070 BE34=SQRT(MAX(0.,1.-4.*RM1))
1071 IF(IMDM.GE.1) THEN
1072 HGZ(1,IMDM)=HGZ(1,IMDM)+FCOF*EF**2*(1.+2.*RM1)*BE34
1073 HGZ(2,IMDM)=HGZ(2,IMDM)+FCOF*EF*VF*(1.+2.*RM1)*BE34
1074 HGZ(3,IMDM)=HGZ(3,IMDM)+FCOF*(VF**2*(1.+2.*RM1)+
1075 & AF**2*(1.-4.*RM1))*BE34
1076 ENDIF
1077 HBW3=HBW3+FCOF*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*BE34
1078 ENDIF
1079 RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4
1080 IF(4.*RM1.LT.1.) THEN
1081 FCOF=1.
1082 IF(I.LE.8) FCOF=3.*RADC4
1083 BE34=SQRT(MAX(0.,1.-4.*RM1))
1084 IF(IMDM.GE.1) THEN
1085 HGZ(4,IMDM)=HGZ(4,IMDM)+FCOF*EF**2*(1.+2.*RM1)*BE34
1086 HGZ(5,IMDM)=HGZ(5,IMDM)+FCOF*EF*VF*(1.+2.*RM1)*BE34
1087 HGZ(6,IMDM)=HGZ(6,IMDM)+FCOF*(VF**2*(1.+2.*RM1)+
1088 & AF**2*(1.-4.*RM1))*BE34
1089 ENDIF
1090 HBW4=HBW4+FCOF*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*BE34
1091 ENDIF
1092 440 CONTINUE
1093C...Propagators: as simulated in PYOFSH and as desired.
1094 GMMZ=PMAS(23,1)*PMAS(23,2)
1095 HBW3=HBW3*XWC*SQMZ/((SQM3-SQMZ)**2+GMMZ**2)
1096 HBW4=HBW4*XWC*SQMZ/((SQM4-SQMZ)**2+GMMZ**2)
1097 MINT(15)=1
1098 MINT(61)=1
1099 CALL PYWIDT(23,SQM3,WDTP,WDTE)
1100 DO 450 J=1,3
1101 HGZ(1,J)=HGZ(1,J)*VINT(111)/SQM3
1102 HGZ(2,J)=HGZ(2,J)*VINT(112)/SQM3
1103 HGZ(3,J)=HGZ(3,J)*VINT(114)/SQM3
1104 450 CONTINUE
1105 MINT(61)=1
1106 CALL PYWIDT(23,SQM4,WDTP,WDTE)
1107 DO 460 J=1,3
1108 HGZ(4,J)=HGZ(4,J)*VINT(111)/SQM4
1109 HGZ(5,J)=HGZ(5,J)*VINT(112)/SQM4
1110 HGZ(6,J)=HGZ(6,J)*VINT(114)/SQM4
1111 460 CONTINUE
1112C...Loop over flavours; separate left- and right-handed couplings.
1113 DO 480 I=MMINA,MMAXA
1114 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 480
1115 EI=KCHG(IABS(I),1)/3.
1116 AI=SIGN(1.,EI)
1117 VI=AI-4.*EI*XWV
1118 VALI=VI-AI
1119 VARI=VI+AI
1120 FCOI=1.
1121 IF(IABS(I).LE.10) FCOI=FACA/3.
1122 DO 470 J=1,3
1123 HL3(J)=EI**2*HGZ(1,J)+EI*VALI*HGZ(2,J)+VALI**2*HGZ(3,J)
1124 HR3(J)=EI**2*HGZ(1,J)+EI*VARI*HGZ(2,J)+VARI**2*HGZ(3,J)
1125 HL4(J)=EI**2*HGZ(4,J)+EI*VALI*HGZ(5,J)+VALI**2*HGZ(6,J)
1126 HR4(J)=EI**2*HGZ(4,J)+EI*VARI*HGZ(5,J)+VARI**2*HGZ(6,J)
1127 470 CONTINUE
1128 FACLR=HL3(1)*HL4(1)+HL3(1)*(HL4(2)+HL4(3))+
1129 & HL4(1)*(HL3(2)+HL3(3))+HL3(2)*HL4(3)+HL4(2)*HL3(3)+
1130 & HR3(1)*HR4(1)+HR3(1)*(HR4(2)+HR4(3))+
1131 & HR4(1)*(HR3(2)+HR3(3))+HR3(2)*HR4(3)+HR4(2)*HR3(3)
1132 NCHN=NCHN+1
1133 ISIG(NCHN,1)=I
1134 ISIG(NCHN,2)=-I
1135 ISIG(NCHN,3)=1
1136 SIGH(NCHN)=0.5*FACZZ*FCOI*FACLR/(HBW3*HBW4)
1137 480 CONTINUE
1138
1139 ELSEIF(ISUB.EQ.23) THEN
1140C...f + f~' -> Z0 + W+/-.
1141 FACZW=COMFAC*0.5*(AEM/XW)**2
1142 FACZW=FACZW*WIDS(23,2)
1143 THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2)
1144 FACBW=1./((SH-SQMW)**2+SQMW*PMAS(24,2)**2)
1145 DO 500 I=MMIN1,MMAX1
1146 IA=IABS(I)
1147 IF(I.EQ.0.OR.IA.GT.20.OR.KFAC(1,I).EQ.0) GOTO 500
1148 DO 490 J=MMIN2,MMAX2
1149 JA=IABS(J)
1150 IF(J.EQ.0.OR.JA.GT.20.OR.KFAC(2,J).EQ.0) GOTO 490
1151 IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 490
1152 IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) GOTO 490
1153 KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
1154 EI=KCHG(IA,1)/3.
1155 AI=SIGN(1.,EI+0.1)
1156 VI=AI-4.*EI*XWV
1157 EJ=KCHG(JA,1)/3.
1158 AJ=SIGN(1.,EJ+0.1)
1159 VJ=AJ-4.*EJ*XWV
1160 IF(VI+AI.GT.0) THEN
1161 VISAV=VI
1162 AISAV=AI
1163 VI=VJ
1164 AI=AJ
1165 VJ=VISAV
1166 AJ=AISAV
1167 ENDIF
1168 FCKM=1.
1169 IF(IA.LE.10) FCKM=VCKM((IA+1)/2,(JA+1)/2)
1170 FCOI=1.
1171 IF(IA.LE.10) FCOI=FACA/3.
1172 NCHN=NCHN+1
1173 ISIG(NCHN,1)=I
1174 ISIG(NCHN,2)=J
1175 ISIG(NCHN,3)=1
1176 SIGH(NCHN)=FACZW*FCOI*FCKM*(FACBW*((9.-8.*XW)/4.*THUH+
1177 & (8.*XW-6.)/4.*SH*(SQM3+SQM4))+(THUH-SH*(SQM3+SQM4))*
1178 & (SH-SQMW)*FACBW*0.5*((VJ+AJ)/TH-(VI+AI)/UH)+
1179 & THUH/(16.*XW1)*((VJ+AJ)**2/TH2+(VI+AI)**2/UH2)+
1180 & SH*(SQM3+SQM4)/(8.*XW1)*(VI+AI)*(VJ+AJ)/(TH*UH))*
1181 & WIDS(24,(5-KCHW)/2)
1182 490 CONTINUE
1183 500 CONTINUE
1184
1185 ELSEIF(ISUB.EQ.24) THEN
1186C...f + f~ -> Z0 + H0 (or H'0, or A0).
1187 THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2)
1188 FACHZ=COMFAC*8.*(AEM*XWC)**2*
1189 & (THUH+2.*SH*SQM3)/((SH-SQMZ)**2+SQMZ*PMAS(23,2)**2)
1190 FACHZ=FACHZ*WIDS(23,2)*WIDS(KFHIGG,2)
1191 IF(MSTP(4).GE.1.OR.IHIGG.GE.2) FACHZ=FACHZ*
1192 & PARU(154+10*IHIGG)**2
1193 DO 510 I=MMINA,MMAXA
1194 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 510
1195 EI=KCHG(IABS(I),1)/3.
1196 AI=SIGN(1.,EI)
1197 VI=AI-4.*EI*XWV
1198 FCOI=1.
1199 IF(IABS(I).LE.10) FCOI=FACA/3.
1200 NCHN=NCHN+1
1201 ISIG(NCHN,1)=I
1202 ISIG(NCHN,2)=-I
1203 ISIG(NCHN,3)=1
1204 SIGH(NCHN)=FACHZ*FCOI*(VI**2+AI**2)
1205 510 CONTINUE
1206
1207 ELSEIF(ISUB.EQ.25) THEN
1208C...f + f~ -> W+ + W-.
1209C...Propagators: Z0, W+- as simulated in PYOFSH and as desired.
1210 CALL PYWIDT(23,SH,WDTP,WDTE)
1211 GMMZC=AEM/(48.*XW*XW1)*SH*WDTP(0)
1212 HBWZC=SH**2/((SH-SQMZ)**2+GMMZC**2)
1213 GMMW=PMAS(24,1)*PMAS(24,2)
1214 HBW3=GMMW/((SQM3-SQMW)**2+GMMW**2)
1215 AEM3=ULALEM(SQM3)
1216 IF(MSTP(8).GE.1) AEM3=AEM
1217 CALL PYWIDT(24,SQM3,WDTP,WDTE)
1218 GMMW3=AEM3/(24.*XW)*SQM3*WDTP(0)
1219 HBW3C=GMMW3/((SQM3-SQMW)**2+GMMW3**2)
1220 HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2)
1221 AEM4=ULALEM(SQM4)
1222 IF(MSTP(8).GE.1) AEM4=AEM
1223 CALL PYWIDT(24,SQM4,WDTP,WDTE)
1224 GMMW4=AEM4/(24.*XW)*SQM4*WDTP(0)
1225 HBW4C=GMMW4/((SQM4-SQMW)**2+GMMW4**2)
1226C...Kinematical functions.
1227 THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2)
1228 THUH34=(2.*SH*(SQM3+SQM4)+THUH)/(SQM3*SQM4)
1229 GS=(((SH-SQM3-SQM4)**2-4.*SQM3*SQM4)*THUH34+12.*THUH)/SH2
1230 GT=THUH34+4.*THUH/TH2
1231 GST=((SH-SQM3-SQM4)*THUH34+4.*(SH*(SQM3+SQM4)-THUH)/TH)/SH
1232 GU=THUH34+4.*THUH/UH2
1233 GSU=((SH-SQM3-SQM4)*THUH34+4.*(SH*(SQM3+SQM4)-THUH)/UH)/SH
1234C...Common factors and couplings.
1235 FACWW=COMFAC*(HBW3C/HBW3)*(HBW4C/HBW4)
1236 FACWW=FACWW*WIDS(24,1)
1237 CGG=AEM**2/2.
1238 CGZ=AEM**2/(4.*XW)*HBWZC*(1.-SQMZ/SH)
1239 CZZ=AEM**2/(32.*XW**2)*HBWZC
1240 CNG=AEM**2/(4.*XW)
1241 CNZ=AEM**2/(16.*XW**2)*HBWZC*(1.-SQMZ/SH)
1242 CNN=AEM**2/(16.*XW**2)
1243C...Coulomb factor for W+W- pair.
1244 IF(MSTP(40).GE.1.AND.MSTP(40).LE.3) THEN
1245 COULE=(SH-4.*SQMW)/(4.*PMAS(24,1))
1246 COULP=MAX(1E-10,0.5*BE34*SQRT(SH))
1247 IF(COULE.LT.100.*PMAS(24,2)) THEN
1248 COULP1=SQRT(0.5*PMAS(24,1)*(SQRT(COULE**2+PMAS(24,2)**2)-
1249 & COULE))
1250 ELSE
1251 COULP1=SQRT(0.5*PMAS(24,1)*(0.5*PMAS(24,2)**2/COULE))
1252 ENDIF
1253 IF(COULE.GT.-100.*PMAS(24,2)) THEN
1254 COULP2=SQRT(0.5*PMAS(24,1)*(SQRT(COULE**2+PMAS(24,2)**2)+
1255 & COULE))
1256 ELSE
1257 COULP2=SQRT(0.5*PMAS(24,1)*(0.5*PMAS(24,2)**2/ABS(COULE)))
1258 ENDIF
1259 IF(MSTP(40).EQ.1) THEN
1260 COULDC=PARU(1)-2.*ATAN((COULP1**2+COULP2**2-COULP**2)/
1261 & MAX(1E-10,2.*COULP*COULP1))
1262 FACCOU=1.+0.5*PARU(101)*COULDC/MAX(1E-5,BE34)
1263 ELSEIF(MSTP(40).EQ.2) THEN
1264 COULCK=CMPLX(COULP1,COULP2)
1265 COULCP=CMPLX(0.,COULP)
1266 COULCD=(COULCK+COULCP)/(COULCK-COULCP)
1267 COULCR=1.+(PARU(101)*SQRT(SH))/(4.*COULCP)*LOG(COULCD)
1268 COULCS=CMPLX(0.,0.)
1269 NSTP=100
1270 DO 515 ISTP=1,NSTP
1271 COULXX=(ISTP-0.5)/NSTP
1272 COULCS=COULCS+(1./COULXX)*LOG((1.+COULXX*COULCD)/
1273 & (1.+COULXX/COULCD))
1274 515 CONTINUE
1275 COULCR=COULCR+(PARU(101)**2*SH)/(16.*COULCP*COULCK)*
1276 & (COULCS/NSTP)
1277 FACCOU=ABS(COULCR)**2
1278 ELSEIF(MSTP(40).EQ.3) THEN
1279 COULDC=PARU(1)-2.*(1.-BE34)**2*ATAN((COULP1**2+COULP2**2-
1280 & COULP**2)/MAX(1E-10,2.*COULP*COULP1))
1281 FACCOU=1.+0.5*PARU(101)*COULDC/MAX(1E-5,BE34)
1282 ENDIF
1283 ELSEIF(MSTP(40).EQ.4) THEN
1284 FACCOU=1.+0.5*PARU(101)*PARU(1)/MAX(1E-5,BE34)
1285 ELSE
1286 FACCOU=1.
1287 ENDIF
1288 VINT(95)=FACCOU
1289 FACWW=FACWW*FACCOU
1290C...Loop over allowed flavours.
1291 DO 520 I=MMINA,MMAXA
1292 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 520
1293 EI=KCHG(IABS(I),1)/3.
1294 AI=SIGN(1.,EI+0.1)
1295 VI=AI-4.*EI*XWV
1296 FCOI=1.
1297 IF(IABS(I).LE.10) FCOI=FACA/3.
1298 IF(AI.LT.0.) THEN
1299 DSIGWW=(CGG*EI**2+CGZ*VI*EI+CZZ*(VI**2+AI**2))*GS+
1300 & (CNG*EI+CNZ*(VI+AI))*GST+CNN*GT
1301 ELSE
1302 DSIGWW=(CGG*EI**2+CGZ*VI*EI+CZZ*(VI**2+AI**2))*GS-
1303 & (CNG*EI+CNZ*(VI+AI))*GSU+CNN*GU
1304 ENDIF
1305 NCHN=NCHN+1
1306 ISIG(NCHN,1)=I
1307 ISIG(NCHN,2)=-I
1308 ISIG(NCHN,3)=1
1309 SIGH(NCHN)=FACWW*FCOI*DSIGWW
1310 520 CONTINUE
1311
1312 ELSEIF(ISUB.EQ.26) THEN
1313C...f + f~' -> W+/- + H0 (or H'0, or A0).
1314 THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2)
1315 FACHW=COMFAC*0.125*(AEM/XW)**2*(THUH+2.*SH*SQM3)/
1316 & ((SH-SQMW)**2+SQMW*PMAS(24,2)**2)
1317 FACHW=FACHW*WIDS(KFHIGG,2)
1318 IF(MSTP(4).GE.1.OR.IHIGG.GE.2) FACHW=FACHW*
1319 & PARU(155+10*IHIGG)**2
1320 DO 540 I=MMIN1,MMAX1
1321 IA=IABS(I)
1322 IF(I.EQ.0.OR.IA.GT.20.OR.KFAC(1,I).EQ.0) GOTO 540
1323 DO 530 J=MMIN2,MMAX2
1324 JA=IABS(J)
1325 IF(J.EQ.0.OR.JA.GT.20.OR.KFAC(1,J).EQ.0) GOTO 530
1326 IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 530
1327 IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) GOTO 530
1328 KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
1329 FCKM=1.
1330 IF(IA.LE.10) FCKM=VCKM((IA+1)/2,(JA+1)/2)
1331 FCOI=1.
1332 IF(IA.LE.10) FCOI=FACA/3.
1333 NCHN=NCHN+1
1334 ISIG(NCHN,1)=I
1335 ISIG(NCHN,2)=J
1336 ISIG(NCHN,3)=1
1337 SIGH(NCHN)=FACHW*FCOI*FCKM*WIDS(24,(5-KCHW)/2)
1338 530 CONTINUE
1339 540 CONTINUE
1340
1341 ELSEIF(ISUB.EQ.27) THEN
1342C...f + f~ -> H0 + H0.
1343
1344 ELSEIF(ISUB.EQ.28) THEN
1345C...f + g -> f + g (q + g -> q + g only).
1346 FACQG1=COMFAC*AS**2*4./9.*((2.+MSTP(34)*1./4.)*UH2/TH2-UH/SH)*
1347 & FACA
1348 FACQG2=COMFAC*AS**2*4./9.*((2.+MSTP(34)*1./4.)*SH2/TH2-SH/UH)
1349 DO 560 I=MMINA,MMAXA
1350 IF(I.EQ.0.OR.IABS(I).GT.10) GOTO 560
1351 DO 550 ISDE=1,2
1352 IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 550
1353 IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 550
1354 NCHN=NCHN+1
1355 ISIG(NCHN,ISDE)=I
1356 ISIG(NCHN,3-ISDE)=21
1357 ISIG(NCHN,3)=1
1358 SIGH(NCHN)=FACQG1
1359 NCHN=NCHN+1
1360 ISIG(NCHN,ISDE)=I
1361 ISIG(NCHN,3-ISDE)=21
1362 ISIG(NCHN,3)=2
1363 SIGH(NCHN)=FACQG2
1364 550 CONTINUE
1365 560 CONTINUE
1366
1367 ELSEIF(ISUB.EQ.29) THEN
1368C...f + g -> f + gamma (q + g -> q + gamma only).
1369 FGQ=COMFAC*FACA*AS*AEM*1./3.*(SH2+UH2)/(-SH*UH)
1370 DO 580 I=MMINA,MMAXA
1371 IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 580
1372 EI=KCHG(IABS(I),1)/3.
1373 FACGQ=FGQ*EI**2
1374 DO 570 ISDE=1,2
1375 IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 570
1376 IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 570
1377 NCHN=NCHN+1
1378 ISIG(NCHN,ISDE)=I
1379 ISIG(NCHN,3-ISDE)=21
1380 ISIG(NCHN,3)=1
1381 SIGH(NCHN)=FACGQ
1382 570 CONTINUE
1383 580 CONTINUE
1384
1385 ELSEIF(ISUB.EQ.30) THEN
1386C...f + g -> f + (gamma*/Z0) (q + g -> q + (gamma*/Z0) only).
1387 FZQ=COMFAC*FACA*AS*AEM*(1./3.)*(SH2+UH2+2.*SQM4*TH)/(-SH*UH)
1388C...gamma, gamma/Z interference and Z couplings to final fermion pairs.
1389 HFGG=0.
1390 HFGZ=0.
1391 HFZZ=0.
1392 HBW4=0.
1393 RADC4=1.+ULALPS(SQM4)/PARU(1)
1394 DO 590 I=1,MIN(16,MDCY(23,3))
1395 IDC=I+MDCY(23,2)-1
1396 IF(MDME(IDC,1).LT.0) GOTO 590
1397 IMDM=0
1398 IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2.OR.MDME(IDC,1).EQ.4)
1399 & IMDM=1
1400 IF(I.LE.8) THEN
1401 EF=KCHG(I,1)/3.
1402 AF=SIGN(1.,EF+0.1)
1403 VF=AF-4.*EF*XWV
1404 ELSEIF(I.LE.16) THEN
1405 EF=KCHG(I+2,1)/3.
1406 AF=SIGN(1.,EF+0.1)
1407 VF=AF-4.*EF*XWV
1408 ENDIF
1409 RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4
1410 IF(4.*RM1.LT.1.) THEN
1411 FCOF=1.
1412 IF(I.LE.8) FCOF=3.*RADC4
1413 BE34=SQRT(MAX(0.,1.-4.*RM1))
1414 IF(IMDM.EQ.1) THEN
1415 HFGG=HFGG+FCOF*EF**2*(1.+2.*RM1)*BE34
1416 HFGZ=HFGZ+FCOF*EF*VF*(1.+2.*RM1)*BE34
1417 HFZZ=HFZZ+FCOF*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*BE34
1418 ENDIF
1419 HBW4=HBW4+FCOF*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*BE34
1420 ENDIF
1421 590 CONTINUE
1422C...Propagators: as simulated in PYOFSH and as desired.
1423 GMMZ=PMAS(23,1)*PMAS(23,2)
1424 HBW4=HBW4*XWC*SQMZ/((SQM4-SQMZ)**2+GMMZ**2)
1425 MINT(15)=1
1426 MINT(61)=1
1427 CALL PYWIDT(23,SQM4,WDTP,WDTE)
1428 HFGG=HFGG*VINT(111)/SQM4
1429 HFGZ=HFGZ*VINT(112)/SQM4
1430 HFZZ=HFZZ*VINT(114)/SQM4
1431C...Loop over flavours; consider full gamma/Z structure.
1432 DO 610 I=MMINA,MMAXA
1433 IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 610
1434 EI=KCHG(IABS(I),1)/3.
1435 AI=SIGN(1.,EI)
1436 VI=AI-4.*EI*XWV
1437 FACZQ=FZQ*(EI**2*HFGG+EI*VI*HFGZ+
1438 & (VI**2+AI**2)*HFZZ)/HBW4
1439 DO 600 ISDE=1,2
1440 IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 600
1441 IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 600
1442 NCHN=NCHN+1
1443 ISIG(NCHN,ISDE)=I
1444 ISIG(NCHN,3-ISDE)=21
1445 ISIG(NCHN,3)=1
1446 SIGH(NCHN)=FACZQ
1447 600 CONTINUE
1448 610 CONTINUE
1449 ENDIF
1450
1451 ELSEIF(ISUB.LE.40) THEN
1452 IF(ISUB.EQ.31) THEN
1453C...f + g -> f' + W+/- (q + g -> q' + W+/- only).
1454 FACWQ=COMFAC*FACA*AS*AEM/XW*1./12.*
1455 & (SH2+UH2+2.*SQM4*TH)/(-SH*UH)
1456C...Propagators: as simulated in PYOFSH and as desired.
1457 GMMW=PMAS(24,1)*PMAS(24,2)
1458 HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2)
1459 CALL PYWIDT(24,SQM4,WDTP,WDTE)
1460 AEMC=ULALEM(SQM4)
1461 IF(MSTP(8).GE.1) AEMC=AEM
1462 GMMWC=SQM4*WDTP(0)*AEMC/(24.*XW)
1463 HBW4C=GMMWC/((SQM4-SQMW)**2+GMMWC**2)
1464 FACWQ=FACWQ*HBW4C/HBW4
1465 DO 630 I=MMINA,MMAXA
1466 IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 630
1467 IA=IABS(I)
1468 KCHW=ISIGN(1,KCHG(IA,1)*ISIGN(1,I))
1469 WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))/WDTP(0)
1470 DO 620 ISDE=1,2
1471 IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 620
1472 IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 620
1473 NCHN=NCHN+1
1474 ISIG(NCHN,ISDE)=I
1475 ISIG(NCHN,3-ISDE)=21
1476 ISIG(NCHN,3)=1
1477 SIGH(NCHN)=FACWQ*VINT(180+I)*WIDSC
1478 620 CONTINUE
1479 630 CONTINUE
1480
1481 ELSEIF(ISUB.EQ.32) THEN
1482C...f + g -> f + H0 (q + g -> q + H0 only).
1483
1484 ELSEIF(ISUB.EQ.33) THEN
1485C...f + gamma -> f + g (q + gamma -> q + g only).
1486 FGQ=COMFAC*AS*AEM*8./3.*(SH2+UH2)/(-SH*UH)
1487 DO 650 I=MMINA,MMAXA
1488 IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 650
1489 EI=KCHG(IABS(I),1)/3.
1490 FACGQ=FGQ*EI**2
1491 DO 640 ISDE=1,2
1492 IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 640
1493 IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 640
1494 NCHN=NCHN+1
1495 ISIG(NCHN,ISDE)=I
1496 ISIG(NCHN,3-ISDE)=22
1497 ISIG(NCHN,3)=1
1498 SIGH(NCHN)=FACGQ
1499 640 CONTINUE
1500 650 CONTINUE
1501
1502 ELSEIF(ISUB.EQ.34) THEN
1503C...f + gamma -> f + gamma.
1504 FGQ=COMFAC*AEM**2*2.*(SH2+UH2)/(-SH*UH)
1505 DO 670 I=MMINA,MMAXA
1506 IF(I.EQ.0) GOTO 670
1507 EI=KCHG(IABS(I),1)/3.
1508 FACGQ=FGQ*EI**4
1509 DO 660 ISDE=1,2
1510 IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 660
1511 IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 660
1512 NCHN=NCHN+1
1513 ISIG(NCHN,ISDE)=I
1514 ISIG(NCHN,3-ISDE)=22
1515 ISIG(NCHN,3)=1
1516 SIGH(NCHN)=FACGQ
1517 660 CONTINUE
1518 670 CONTINUE
1519
1520 ELSEIF(ISUB.EQ.35) THEN
1521C...f + gamma -> f + (gamma*/Z0).
1522 FZQN=COMFAC*2.*AEM**2*(SH2+UH2+2.*SQM4*TH)
1523 FZQD=SQPTH*SQM4-SH*UH
1524C...gamma, gamma/Z interference and Z couplings to final fermion pairs.
1525 HFGG=0.
1526 HFGZ=0.
1527 HFZZ=0.
1528 HBW4=0.
1529 RADC4=1.+ULALPS(SQM4)/PARU(1)
1530 DO 680 I=1,MIN(16,MDCY(23,3))
1531 IDC=I+MDCY(23,2)-1
1532 IF(MDME(IDC,1).LT.0) GOTO 680
1533 IMDM=0
1534 IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2.OR.MDME(IDC,1).EQ.4)
1535 & IMDM=1
1536 IF(I.LE.8) THEN
1537 EF=KCHG(I,1)/3.
1538 AF=SIGN(1.,EF+0.1)
1539 VF=AF-4.*EF*XWV
1540 ELSEIF(I.LE.16) THEN
1541 EF=KCHG(I+2,1)/3.
1542 AF=SIGN(1.,EF+0.1)
1543 VF=AF-4.*EF*XWV
1544 ENDIF
1545 RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4
1546 IF(4.*RM1.LT.1.) THEN
1547 FCOF=1.
1548 IF(I.LE.8) FCOF=3.*RADC4
1549 BE34=SQRT(MAX(0.,1.-4.*RM1))
1550 IF(IMDM.EQ.1) THEN
1551 HFGG=HFGG+FCOF*EF**2*(1.+2.*RM1)*BE34
1552 HFGZ=HFGZ+FCOF*EF*VF*(1.+2.*RM1)*BE34
1553 HFZZ=HFZZ+FCOF*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*BE34
1554 ENDIF
1555 HBW4=HBW4+FCOF*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*BE34
1556 ENDIF
1557 680 CONTINUE
1558C...Propagators: as simulated in PYOFSH and as desired.
1559 GMMZ=PMAS(23,1)*PMAS(23,2)
1560 HBW4=HBW4*XWC*SQMZ/((SQM4-SQMZ)**2+GMMZ**2)
1561 MINT(15)=1
1562 MINT(61)=1
1563 CALL PYWIDT(23,SQM4,WDTP,WDTE)
1564 HFGG=HFGG*VINT(111)/SQM4
1565 HFGZ=HFGZ*VINT(112)/SQM4
1566 HFZZ=HFZZ*VINT(114)/SQM4
1567C...Loop over flavours; consider full gamma/Z structure.
1568 DO 700 I=MMINA,MMAXA
1569 IF(I.EQ.0) GOTO 700
1570 EI=KCHG(IABS(I),1)/3.
1571 AI=SIGN(1.,EI)
1572 VI=AI-4.*EI*XWV
1573 FACZQ=EI**2*(EI**2*HFGG+EI*VI*HFGZ+
1574 & (VI**2+AI**2)*HFZZ)/HBW4
1575 DO 690 ISDE=1,2
1576 IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 690
1577 IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 690
1578 NCHN=NCHN+1
1579 ISIG(NCHN,ISDE)=I
1580 ISIG(NCHN,3-ISDE)=22
1581 ISIG(NCHN,3)=1
1582 SIGH(NCHN)=FACZQ*FZQN/MAX(PMAS(IABS(I),1)**2*SQM4,FZQD)
1583 690 CONTINUE
1584 700 CONTINUE
1585
1586 ELSEIF(ISUB.EQ.36) THEN
1587C...f + gamma -> f' + W+/-.
1588 FWQ=COMFAC*AEM**2/(2.*XW)*
1589 & (SH2+UH2+2.*SQM4*TH)/(SQPTH*SQM4-SH*UH)
1590C...Propagators: as simulated in PYOFSH and as desired.
1591 GMMW=PMAS(24,1)*PMAS(24,2)
1592 HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2)
1593 CALL PYWIDT(24,SQM4,WDTP,WDTE)
1594 AEMC=ULALEM(SQM4)
1595 IF(MSTP(8).GE.1) AEMC=AEM
1596 GMMWC=SQM4*WDTP(0)*AEMC/(24.*XW)
1597 HBW4C=GMMWC/((SQM4-SQMW)**2+GMMWC**2)
1598 FWQ=FWQ*HBW4C/HBW4
1599 DO 720 I=MMINA,MMAXA
1600 IF(I.EQ.0) GOTO 720
1601 IA=IABS(I)
1602 EIA=ABS(KCHG(IABS(I),1)/3.)
1603 FACWQ=FWQ*(EIA-SH/(SH+UH))**2
1604 KCHW=ISIGN(1,KCHG(IA,1)*ISIGN(1,I))
1605 WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))/WDTP(0)
1606 DO 710 ISDE=1,2
1607 IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 710
1608 IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 710
1609 NCHN=NCHN+1
1610 ISIG(NCHN,ISDE)=I
1611 ISIG(NCHN,3-ISDE)=22
1612 ISIG(NCHN,3)=1
1613 SIGH(NCHN)=FACWQ*VINT(180+I)*WIDSC
1614 710 CONTINUE
1615 720 CONTINUE
1616
1617 ELSEIF(ISUB.EQ.37) THEN
1618C...f + gamma -> f + H0.
1619
1620 ELSEIF(ISUB.EQ.38) THEN
1621C...f + Z0 -> f + g (q + Z0 -> q + g only).
1622
1623 ELSEIF(ISUB.EQ.39) THEN
1624C...f + Z0 -> f + gamma.
1625
1626 ELSEIF(ISUB.EQ.40) THEN
1627C...f + Z0 -> f + Z0.
1628 ENDIF
1629
1630 ELSEIF(ISUB.LE.50) THEN
1631 IF(ISUB.EQ.41) THEN
1632C...f + Z0 -> f' + W+/-.
1633
1634 ELSEIF(ISUB.EQ.42) THEN
1635C...f + Z0 -> f + H0.
1636
1637 ELSEIF(ISUB.EQ.43) THEN
1638C...f + W+/- -> f' + g (q + W+/- -> q' + g only).
1639
1640 ELSEIF(ISUB.EQ.44) THEN
1641C...f + W+/- -> f' + gamma.
1642
1643 ELSEIF(ISUB.EQ.45) THEN
1644C...f + W+/- -> f' + Z0.
1645
1646 ELSEIF(ISUB.EQ.46) THEN
1647C...f + W+/- -> f' + W+/-.
1648
1649 ELSEIF(ISUB.EQ.47) THEN
1650C...f + W+/- -> f' + H0.
1651
1652 ELSEIF(ISUB.EQ.48) THEN
1653C...f + H0 -> f + g (q + H0 -> q + g only).
1654
1655 ELSEIF(ISUB.EQ.49) THEN
1656C...f + H0 -> f + gamma.
1657
1658 ELSEIF(ISUB.EQ.50) THEN
1659C...f + H0 -> f + Z0.
1660 ENDIF
1661
1662 ELSEIF(ISUB.LE.60) THEN
1663 IF(ISUB.EQ.51) THEN
1664C...f + H0 -> f' + W+/-.
1665
1666 ELSEIF(ISUB.EQ.52) THEN
1667C...f + H0 -> f + H0.
1668
1669 ELSEIF(ISUB.EQ.53) THEN
1670C...g + g -> f + f~ (g + g -> q + q~ only).
1671 CALL PYWIDT(21,SH,WDTP,WDTE)
1672 FACQQ1=COMFAC*AS**2*1./6.*(UH/TH-(2.+MSTP(34)*1./4.)*UH2/SH2)*
1673 & (WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))*FACA
1674 FACQQ2=COMFAC*AS**2*1./6.*(TH/UH-(2.+MSTP(34)*1./4.)*TH2/SH2)*
1675 & (WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))*FACA
1676 IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 730
1677 NCHN=NCHN+1
1678 ISIG(NCHN,1)=21
1679 ISIG(NCHN,2)=21
1680 ISIG(NCHN,3)=1
1681 SIGH(NCHN)=FACQQ1
1682 NCHN=NCHN+1
1683 ISIG(NCHN,1)=21
1684 ISIG(NCHN,2)=21
1685 ISIG(NCHN,3)=2
1686 SIGH(NCHN)=FACQQ2
1687 730 CONTINUE
1688
1689 ELSEIF(ISUB.EQ.54) THEN
1690C...g + gamma -> f + f~ (g + gamma -> q + q~ only).
1691 CALL PYWIDT(21,SH,WDTP,WDTE)
1692 WDTESU=0.
1693 DO 740 I=1,MIN(8,MDCY(21,3))
1694 EF=KCHG(I,1)/3.
1695 WDTESU=WDTESU+EF**2*(WDTE(I,1)+WDTE(I,2)+WDTE(I,3)+WDTE(I,4))
1696 740 CONTINUE
1697 FACQQ=COMFAC*AEM*AS*WDTESU*(TH2+UH2)/(TH*UH)
1698 IF(KFAC(1,21)*KFAC(2,22).NE.0) THEN
1699 NCHN=NCHN+1
1700 ISIG(NCHN,1)=21
1701 ISIG(NCHN,2)=22
1702 ISIG(NCHN,3)=1
1703 SIGH(NCHN)=FACQQ
1704 ENDIF
1705 IF(KFAC(1,22)*KFAC(2,21).NE.0) THEN
1706 NCHN=NCHN+1
1707 ISIG(NCHN,1)=22
1708 ISIG(NCHN,2)=21
1709 ISIG(NCHN,3)=1
1710 SIGH(NCHN)=FACQQ
1711 ENDIF
1712
1713 ELSEIF(ISUB.EQ.55) THEN
1714C...g + Z -> f + f~ (g + Z -> q + q~ only).
1715
1716 ELSEIF(ISUB.EQ.56) THEN
1717C...g + W -> f + f'~ (g + W -> q + q'~ only).
1718
1719 ELSEIF(ISUB.EQ.57) THEN
1720C...g + H0 -> f + f~ (g + H0 -> q + q~ only).
1721
1722 ELSEIF(ISUB.EQ.58) THEN
1723C...gamma + gamma -> f + f~.
1724 CALL PYWIDT(22,SH,WDTP,WDTE)
1725 WDTESU=0.
1726 DO 750 I=1,MIN(12,MDCY(22,3))
1727 IF(I.LE.8) EF= KCHG(I,1)/3.
1728 IF(I.GE.9) EF= KCHG(9+2*(I-8),1)/3.
1729 WDTESU=WDTESU+EF**2*(WDTE(I,1)+WDTE(I,2)+WDTE(I,3)+WDTE(I,4))
1730 750 CONTINUE
1731 FACFF=COMFAC*AEM**2*WDTESU*2.*(TH2+UH2)/(TH*UH)
1732 IF(KFAC(1,22)*KFAC(2,22).NE.0) THEN
1733 NCHN=NCHN+1
1734 ISIG(NCHN,1)=22
1735 ISIG(NCHN,2)=22
1736 ISIG(NCHN,3)=1
1737 SIGH(NCHN)=FACFF
1738 ENDIF
1739
1740 ELSEIF(ISUB.EQ.59) THEN
1741C...gamma + Z0 -> f + f~.
1742
1743 ELSEIF(ISUB.EQ.60) THEN
1744C...gamma + W+/- -> f + f~'.
1745 ENDIF
1746
1747 ELSEIF(ISUB.LE.70) THEN
1748 IF(ISUB.EQ.61) THEN
1749C...gamma + H0 -> f + f~.
1750
1751 ELSEIF(ISUB.EQ.62) THEN
1752C...Z0 + Z0 -> f + f~.
1753
1754 ELSEIF(ISUB.EQ.63) THEN
1755C...Z0 + W+/- -> f + f~'.
1756
1757 ELSEIF(ISUB.EQ.64) THEN
1758C...Z0 + H0 -> f + f~.
1759
1760 ELSEIF(ISUB.EQ.65) THEN
1761C...W+ + W- -> f + f~.
1762
1763 ELSEIF(ISUB.EQ.66) THEN
1764C...W+/- + H0 -> f + f~'.
1765
1766 ELSEIF(ISUB.EQ.67) THEN
1767C...H0 + H0 -> f + f~.
1768
1769 ELSEIF(ISUB.EQ.68) THEN
1770C...g + g -> g + g.
1771 FACGG1=COMFAC*AS**2*9./4.*(SH2/TH2+2.*SH/TH+3.+2.*TH/SH+
1772 & TH2/SH2)*FACA
1773 FACGG2=COMFAC*AS**2*9./4.*(UH2/SH2+2.*UH/SH+3.+2.*SH/UH+
1774 & SH2/UH2)*FACA
1775 FACGG3=COMFAC*AS**2*9./4.*(TH2/UH2+2.*TH/UH+3.+2.*UH/TH+
1776 & UH2/TH2)
1777 IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 760
1778 NCHN=NCHN+1
1779 ISIG(NCHN,1)=21
1780 ISIG(NCHN,2)=21
1781 ISIG(NCHN,3)=1
1782 SIGH(NCHN)=0.5*FACGG1
1783 NCHN=NCHN+1
1784 ISIG(NCHN,1)=21
1785 ISIG(NCHN,2)=21
1786 ISIG(NCHN,3)=2
1787 SIGH(NCHN)=0.5*FACGG2
1788 NCHN=NCHN+1
1789 ISIG(NCHN,1)=21
1790 ISIG(NCHN,2)=21
1791 ISIG(NCHN,3)=3
1792 SIGH(NCHN)=0.5*FACGG3
1793 760 CONTINUE
1794
1795 ELSEIF(ISUB.EQ.69) THEN
1796C...gamma + gamma -> W+ + W-.
1797 SQMWE=MAX(0.5*SQMW,SQRT(SQM3*SQM4))
1798 FPROP=SH2/((SQMWE-TH)*(SQMWE-UH))
1799 FACWW=COMFAC*6.*AEM**2*(1.-FPROP*(4./3.+2.*SQMWE/SH)+
1800 & FPROP**2*(2./3.+2.*(SQMWE/SH)**2))*WIDS(24,1)
1801 IF(KFAC(1,22)*KFAC(2,22).EQ.0) GOTO 770
1802 NCHN=NCHN+1
1803 ISIG(NCHN,1)=22
1804 ISIG(NCHN,2)=22
1805 ISIG(NCHN,3)=1
1806 SIGH(NCHN)=FACWW
1807 770 CONTINUE
1808
1809 ELSEIF(ISUB.EQ.70) THEN
1810C...gamma + W+/- -> Z0 + W+/-.
1811 SQMWE=MAX(0.5*SQMW,SQRT(SQM3*SQM4))
1812 FPROP=(TH-SQMWE)**2/(-SH*(SQMWE-UH))
1813 FACZW=COMFAC*6.*AEM**2*(XW1/XW)*
1814 & (1.-FPROP*(4./3.+2.*SQMWE/(TH-SQMWE))+
1815 & FPROP**2*(2./3.+2.*(SQMWE/(TH-SQMWE))**2))*WIDS(23,2)
1816 DO 790 KCHW=1,-1,-2
1817 DO 780 ISDE=1,2
1818 IF(KFAC(ISDE,22)*KFAC(3-ISDE,24*KCHW).EQ.0) GOTO 780
1819 NCHN=NCHN+1
1820 ISIG(NCHN,ISDE)=22
1821 ISIG(NCHN,3-ISDE)=24*KCHW
1822 ISIG(NCHN,3)=1
1823 SIGH(NCHN)=FACZW*WIDS(24,(5-KCHW)/2)
1824 780 CONTINUE
1825 790 CONTINUE
1826 ENDIF
1827
1828 ELSEIF(ISUB.LE.80) THEN
1829 IF(ISUB.EQ.71) THEN
1830C...Z0 + Z0 -> Z0 + Z0.
1831 IF(SH.LE.4.01*SQMZ) GOTO 820
1832
1833 IF(MSTP(46).LE.2) THEN
1834C...Exact scattering ME:s for on-mass-shell gauge bosons.
1835 BE2=1.-4.*SQMZ/SH
1836 TH=-0.5*SH*BE2*(1.-CTH)
1837 UH=-0.5*SH*BE2*(1.+CTH)
1838 IF(MAX(TH,UH).GT.-1.) GOTO 820
1839 SHANG=1./XW1*SQMW/SQMZ*(1.+BE2)**2
1840 ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG
1841 ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG
1842 THANG=1./XW1*SQMW/SQMZ*(BE2-CTH)**2
1843 ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG
1844 ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG
1845 UHANG=1./XW1*SQMW/SQMZ*(BE2+CTH)**2
1846 AUHRE=(UH-SQMH)/((UH-SQMH)**2+GMMH**2)*UHANG
1847 AUHIM=-GMMH/((UH-SQMH)**2+GMMH**2)*UHANG
1848 FACZZ=COMFAC*1./(4096.*PARU(1)**2*16.*XW1**2)*
1849 & (AEM/XW)**4*(SH/SQMW)**2*(SQMZ/SQMW)*SH2
1850 IF(MSTP(46).LE.0) FACZZ=FACZZ*(ASHRE**2+ASHIM**2)
1851 IF(MSTP(46).EQ.1) FACZZ=FACZZ*((ASHRE+ATHRE+AUHRE)**2+
1852 & (ASHIM+ATHIM+AUHIM)**2)
1853 IF(MSTP(46).EQ.2) FACZZ=0.
1854
1855 ELSE
1856C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron.
1857 FACZZ=COMFAC*(AEM/(16.*PARU(1)*XW*XW1))**2*(64./9.)*
1858 & ABS(A00U+2.*A20U)**2
1859 ENDIF
1860 FACZZ=FACZZ*WIDS(23,1)
1861
1862 DO 810 I=MMIN1,MMAX1
1863 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 810
1864 EI=KCHG(IABS(I),1)/3.
1865 AI=SIGN(1.,EI)
1866 VI=AI-4.*EI*XWV
1867 AVI=AI**2+VI**2
1868 DO 800 J=MMIN2,MMAX2
1869 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 800
1870 EJ=KCHG(IABS(J),1)/3.
1871 AJ=SIGN(1.,EJ)
1872 VJ=AJ-4.*EJ*XWV
1873 AVJ=AJ**2+VJ**2
1874 NCHN=NCHN+1
1875 ISIG(NCHN,1)=I
1876 ISIG(NCHN,2)=J
1877 ISIG(NCHN,3)=1
1878 SIGH(NCHN)=0.5*FACZZ*AVI*AVJ
1879 800 CONTINUE
1880 810 CONTINUE
1881 820 CONTINUE
1882
1883 ELSEIF(ISUB.EQ.72) THEN
1884C...Z0 + Z0 -> W+ + W-.
1885 IF(SH.LE.4.01*SQMZ) GOTO 850
1886
1887 IF(MSTP(46).LE.2) THEN
1888C...Exact scattering ME:s for on-mass-shell gauge bosons.
1889 BE2=SQRT((1.-4.*SQMW/SH)*(1.-4.*SQMZ/SH))
1890 CTH2=CTH**2
1891 TH=-0.5*SH*(1.-2.*(SQMW+SQMZ)/SH-BE2*CTH)
1892 UH=-0.5*SH*(1.-2.*(SQMW+SQMZ)/SH+BE2*CTH)
1893 IF(MAX(TH,UH).GT.-1.) GOTO 850
1894 SHANG=4.*SQRT(SQMW/(SQMZ*XW1))*(1.-2.*SQMW/SH)*
1895 & (1.-2.*SQMZ/SH)
1896 ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG
1897 ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG
1898 ATWRE=XW1/SQMZ*SH/(TH-SQMW)*((CTH-BE2)**2*(3./2.+BE2/2.*
1899 & CTH-(SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4.*((SQMW+SQMZ)/
1900 & SH*(1.-3.*CTH2)+8.*SQMW*SQMZ/SH2*(2.*CTH2-1.)+
1901 & 4.*(SQMW**2+SQMZ**2)/SH2*CTH2+2.*(SQMW+SQMZ)/SH*BE2*CTH))
1902 ATWIM=0.
1903 AUWRE=XW1/SQMZ*SH/(UH-SQMW)*((CTH+BE2)**2*(3./2.-BE2/2.*
1904 & CTH-(SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4.*((SQMW+SQMZ)/
1905 & SH*(1.-3.*CTH2)+8.*SQMW*SQMZ/SH2*(2.*CTH2-1.)+
1906 & 4.*(SQMW**2+SQMZ**2)/SH2*CTH2-2.*(SQMW+SQMZ)/SH*BE2*CTH))
1907 AUWIM=0.
1908 A4RE=2.*XW1/SQMZ*(3.-CTH2-4.*(SQMW+SQMZ)/SH)
1909 A4IM=0.
1910 FACWW=COMFAC*1./(4096.*PARU(1)**2*16.*XW1**2)*
1911 & (AEM/XW)**4*(SH/SQMW)**2*(SQMZ/SQMW)*SH2
1912 IF(MSTP(46).LE.0) FACWW=FACWW*(ASHRE**2+ASHIM**2)
1913 IF(MSTP(46).EQ.1) FACWW=FACWW*((ASHRE+ATWRE+AUWRE+A4RE)**2+
1914 & (ASHIM+ATWIM+AUWIM+A4IM)**2)
1915 IF(MSTP(46).EQ.2) FACWW=FACWW*((ATWRE+AUWRE+A4RE)**2+
1916 & (ATWIM+AUWIM+A4IM)**2)
1917
1918 ELSE
1919C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron.
1920 FACWW=COMFAC*(AEM/(16.*PARU(1)*XW*XW1))**2*(64./9.)*
1921 & ABS(A00U-A20U)**2
1922 ENDIF
1923 FACWW=FACWW*WIDS(24,1)
1924
1925 DO 840 I=MMIN1,MMAX1
1926 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 840
1927 EI=KCHG(IABS(I),1)/3.
1928 AI=SIGN(1.,EI)
1929 VI=AI-4.*EI*XWV
1930 AVI=AI**2+VI**2
1931 DO 830 J=MMIN2,MMAX2
1932 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 830
1933 EJ=KCHG(IABS(J),1)/3.
1934 AJ=SIGN(1.,EJ)
1935 VJ=AJ-4.*EJ*XWV
1936 AVJ=AJ**2+VJ**2
1937 NCHN=NCHN+1
1938 ISIG(NCHN,1)=I
1939 ISIG(NCHN,2)=J
1940 ISIG(NCHN,3)=1
1941 SIGH(NCHN)=FACWW*AVI*AVJ
1942 830 CONTINUE
1943 840 CONTINUE
1944 850 CONTINUE
1945
1946 ELSEIF(ISUB.EQ.73) THEN
1947C...Z0 + W+/- -> Z0 + W+/-.
1948 IF(SH.LE.2.*SQMZ+2.*SQMW) GOTO 880
1949
1950 IF(MSTP(46).LE.2) THEN
1951C...Exact scattering ME:s for on-mass-shell gauge bosons.
1952 BE2=1.-2.*(SQMZ+SQMW)/SH+((SQMZ-SQMW)/SH)**2
1953 EP1=1.-(SQMZ-SQMW)/SH
1954 EP2=1.+(SQMZ-SQMW)/SH
1955 TH=-0.5*SH*BE2*(1.-CTH)
1956 UH=(SQMZ-SQMW)**2/SH-0.5*SH*BE2*(1.+CTH)
1957 IF(MAX(TH,UH).GT.-1.) GOTO 880
1958 THANG=(BE2-EP1*CTH)*(BE2-EP2*CTH)
1959 ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG
1960 ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG
1961 ASWRE=-XW1/SQMZ*SH/(SH-SQMW)*(-BE2*(EP1+EP2)**4*CTH+
1962 & 1./4.*(BE2+EP1*EP2)**2*((EP1-EP2)**2-4.*BE2*CTH)+
1963 & 2.*BE2*(BE2+EP1*EP2)*(EP1+EP2)**2*CTH-
1964 & 1./16.*SH/SQMW*(EP1**2-EP2**2)**2*(BE2+EP1*EP2)**2)
1965 ASWIM=0.
1966 AUWRE=XW1/SQMZ*SH/(UH-SQMW)*(-BE2*(EP2+EP1*CTH)*
1967 & (EP1+EP2*CTH)*(BE2+EP1*EP2)+BE2*(EP2+EP1*CTH)*
1968 & (BE2+EP1*EP2*CTH)*(2.*EP2-EP2*CTH+EP1)-BE2*(EP2+EP1*CTH)**2*
1969 & (BE2-EP2**2*CTH)-1./8.*(BE2+EP1*EP2*CTH)**2*((EP1+EP2)**2+
1970 & 2.*BE2*(1.-CTH))+1./32.*SH/SQMW*(BE2+EP1*EP2*CTH)**2*
1971 & (EP1**2-EP2**2)**2-BE2*(EP1+EP2*CTH)*(EP2+EP1*CTH)*
1972 & (BE2+EP1*EP2)+BE2*(EP1+EP2*CTH)*(BE2+EP1*EP2*CTH)*
1973 & (2.*EP1-EP1*CTH+EP2)-BE2*(EP1+EP2*CTH)**2*(BE2-EP1**2*CTH)-
1974 & 1./8.*(BE2+EP1*EP2*CTH)**2*((EP1+EP2)**2+2.*BE2*(1.-CTH))+
1975 & 1./32.*SH/SQMW*(BE2+EP1*EP2*CTH)**2*(EP1**2-EP2**2)**2)
1976 AUWIM=0.
1977 A4RE=XW1/SQMZ*(EP1**2*EP2**2*(CTH**2-1.)-
1978 & 2.*BE2*(EP1**2+EP2**2+EP1*EP2)*CTH-2.*BE2*EP1*EP2)
1979 A4IM=0.
1980 FACZW=COMFAC*1./(4096.*PARU(1)**2*4.*XW1)*(AEM/XW)**4*
1981 & (SH/SQMW)**2*SQRT(SQMZ/SQMW)*SH2
1982 IF(MSTP(46).LE.0) FACZW=0.
1983 IF(MSTP(46).EQ.1) FACZW=FACZW*((ATHRE+ASWRE+AUWRE+A4RE)**2+
1984 & (ATHIM+ASWIM+AUWIM+A4IM)**2)
1985 IF(MSTP(46).EQ.2) FACZW=FACZW*((ASWRE+AUWRE+A4RE)**2+
1986 & (ASWIM+AUWIM+A4IM)**2)
1987
1988 ELSE
1989C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron.
1990 FACZW=COMFAC*AEM**2/(64.*PARU(1)**2*XW**2*XW1)*16.*
1991 & ABS(A20U+3.*A11U*CTH)**2
1992 ENDIF
1993 FACZW=FACZW*WIDS(23,2)
1994
1995 DO 870 I=MMIN1,MMAX1
1996 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 870
1997 EI=KCHG(IABS(I),1)/3.
1998 AI=SIGN(1.,EI)
1999 VI=AI-4.*EI*XWV
2000 AVI=AI**2+VI**2
2001 KCHWI=ISIGN(1,KCHG(IABS(I),1)*ISIGN(1,I))
2002 DO 860 J=MMIN2,MMAX2
2003 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 860
2004 EJ=KCHG(IABS(J),1)/3.
2005 AJ=SIGN(1.,EJ)
2006 VJ=AI-4.*EJ*XWV
2007 AVJ=AJ**2+VJ**2
2008 KCHWJ=ISIGN(1,KCHG(IABS(J),1)*ISIGN(1,J))
2009 NCHN=NCHN+1
2010 ISIG(NCHN,1)=I
2011 ISIG(NCHN,2)=J
2012 ISIG(NCHN,3)=1
2013 SIGH(NCHN)=FACZW*AVI*VINT(180+J)*WIDS(24,(5-KCHWJ)/2)
2014 NCHN=NCHN+1
2015 ISIG(NCHN,1)=I
2016 ISIG(NCHN,2)=J
2017 ISIG(NCHN,3)=2
2018 SIGH(NCHN)=FACZW*VINT(180+I)*WIDS(24,(5-KCHWI)/2)*AVJ
2019 860 CONTINUE
2020 870 CONTINUE
2021 880 CONTINUE
2022
2023 ELSEIF(ISUB.EQ.75) THEN
2024C...W+ + W- -> gamma + gamma.
2025
2026 ELSEIF(ISUB.EQ.76) THEN
2027C...W+ + W- -> Z0 + Z0.
2028 IF(SH.LE.4.01*SQMZ) GOTO 910
2029
2030 IF(MSTP(46).LE.2) THEN
2031C...Exact scattering ME:s for on-mass-shell gauge bosons.
2032 BE2=SQRT((1.-4.*SQMW/SH)*(1.-4.*SQMZ/SH))
2033 CTH2=CTH**2
2034 TH=-0.5*SH*(1.-2.*(SQMW+SQMZ)/SH-BE2*CTH)
2035 UH=-0.5*SH*(1.-2.*(SQMW+SQMZ)/SH+BE2*CTH)
2036 IF(MAX(TH,UH).GT.-1.) GOTO 910
2037 SHANG=4.*SQRT(SQMW/(SQMZ*XW1))*(1.-2.*SQMW/SH)*
2038 & (1.-2.*SQMZ/SH)
2039 ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG
2040 ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG
2041 ATWRE=XW1/SQMZ*SH/(TH-SQMW)*((CTH-BE2)**2*(3./2.+BE2/2.*
2042 & CTH-(SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4.*((SQMW+SQMZ)/
2043 & SH*(1.-3.*CTH2)+8.*SQMW*SQMZ/SH2*(2.*CTH2-1.)+
2044 & 4.*(SQMW**2+SQMZ**2)/SH2*CTH2+2.*(SQMW+SQMZ)/SH*BE2*CTH))
2045 ATWIM=0.
2046 AUWRE=XW1/SQMZ*SH/(UH-SQMW)*((CTH+BE2)**2*(3./2.-BE2/2.*
2047 & CTH-(SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4.*((SQMW+SQMZ)/
2048 & SH*(1.-3.*CTH2)+8.*SQMW*SQMZ/SH2*(2.*CTH2-1.)+
2049 & 4.*(SQMW**2+SQMZ**2)/SH2*CTH2-2.*(SQMW+SQMZ)/SH*BE2*CTH))
2050 AUWIM=0.
2051 A4RE=2.*XW1/SQMZ*(3.-CTH2-4.*(SQMW+SQMZ)/SH)
2052 A4IM=0.
2053 FACZZ=COMFAC*1./(4096.*PARU(1)**2)*(AEM/XW)**4*
2054 & (SH/SQMW)**2*SH2
2055 IF(MSTP(46).LE.0) FACZZ=FACZZ*(ASHRE**2+ASHIM**2)
2056 IF(MSTP(46).EQ.1) FACZZ=FACZZ*((ASHRE+ATWRE+AUWRE+A4RE)**2+
2057 & (ASHIM+ATWIM+AUWIM+A4IM)**2)
2058 IF(MSTP(46).EQ.2) FACZZ=FACZZ*((ATWRE+AUWRE+A4RE)**2+
2059 & (ATWIM+AUWIM+A4IM)**2)
2060
2061 ELSE
2062C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron.
2063 FACZZ=COMFAC*(AEM/(4.*PARU(1)*XW))**2*(64./9.)*
2064 & ABS(A00U-A20U)**2
2065 ENDIF
2066 FACZZ=FACZZ*WIDS(23,1)
2067
2068 DO 900 I=MMIN1,MMAX1
2069 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 900
2070 EI=SIGN(1.,FLOAT(I))*KCHG(IABS(I),1)
2071 DO 890 J=MMIN2,MMAX2
2072 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 890
2073 EJ=SIGN(1.,FLOAT(J))*KCHG(IABS(J),1)
2074 IF(EI*EJ.GT.0.) GOTO 890
2075 NCHN=NCHN+1
2076 ISIG(NCHN,1)=I
2077 ISIG(NCHN,2)=J
2078 ISIG(NCHN,3)=1
2079 SIGH(NCHN)=0.5*FACZZ*VINT(180+I)*VINT(180+J)
2080 890 CONTINUE
2081 900 CONTINUE
2082 910 CONTINUE
2083
2084 ELSEIF(ISUB.EQ.77) THEN
2085C...W+/- + W+/- -> W+/- + W+/-.
2086 IF(SH.LE.4.01*SQMW) GOTO 940
2087
2088 IF(MSTP(46).LE.2) THEN
2089C...Exact scattering ME:s for on-mass-shell gauge bosons.
2090 BE2=1.-4.*SQMW/SH
2091 BE4=BE2**2
2092 CTH2=CTH**2
2093 CTH3=CTH**3
2094 TH=-0.5*SH*BE2*(1.-CTH)
2095 UH=-0.5*SH*BE2*(1.+CTH)
2096 IF(MAX(TH,UH).GT.-1.) GOTO 940
2097 SHANG=(1.+BE2)**2
2098 ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG
2099 ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG
2100 THANG=(BE2-CTH)**2
2101 ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG
2102 ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG
2103 UHANG=(BE2+CTH)**2
2104 AUHRE=(UH-SQMH)/((UH-SQMH)**2+GMMH**2)*UHANG
2105 AUHIM=-GMMH/((UH-SQMH)**2+GMMH**2)*UHANG
2106 SGZANG=1./SQMW*BE2*(3.-BE2)**2*CTH
2107 ASGRE=XW*SGZANG
2108 ASGIM=0.
2109 ASZRE=XW1*SH/(SH-SQMZ)*SGZANG
2110 ASZIM=0.
2111 TGZANG=1./SQMW*(BE2*(4.-2.*BE2+BE4)+BE2*(4.-10.*BE2+BE4)*CTH+
2112 & (2.-11.*BE2+10.*BE4)*CTH2+BE2*CTH3)
2113 ATGRE=0.5*XW*SH/TH*TGZANG
2114 ATGIM=0.
2115 ATZRE=0.5*XW1*SH/(TH-SQMZ)*TGZANG
2116 ATZIM=0.
2117 UGZANG=1./SQMW*(BE2*(4.-2.*BE2+BE4)-BE2*(4.-10.*BE2+BE4)*CTH+
2118 & (2.-11.*BE2+10.*BE4)*CTH2-BE2*CTH3)
2119 AUGRE=0.5*XW*SH/UH*UGZANG
2120 AUGIM=0.
2121 AUZRE=0.5*XW1*SH/(UH-SQMZ)*UGZANG
2122 AUZIM=0.
2123 A4ARE=1./SQMW*(1.+2.*BE2-6.*BE2*CTH-CTH2)
2124 A4AIM=0.
2125 A4SRE=2./SQMW*(1.+2.*BE2-CTH2)
2126 A4SIM=0.
2127 FWW=COMFAC*1./(4096.*PARU(1)**2)*(AEM/XW)**4*(SH/SQMW)**2*SH2
2128 IF(MSTP(46).LE.0) THEN
2129 AWWARE=ASHRE
2130 AWWAIM=ASHIM
2131 AWWSRE=0.
2132 AWWSIM=0.
2133 ELSEIF(MSTP(46).EQ.1) THEN
2134 AWWARE=ASHRE+ATHRE+ASGRE+ASZRE+ATGRE+ATZRE+A4ARE
2135 AWWAIM=ASHIM+ATHIM+ASGIM+ASZIM+ATGIM+ATZIM+A4AIM
2136 AWWSRE=-ATHRE-AUHRE+ATGRE+ATZRE+AUGRE+AUZRE+A4SRE
2137 AWWSIM=-ATHIM-AUHIM+ATGIM+ATZIM+AUGIM+AUZIM+A4SIM
2138 ELSE
2139 AWWARE=ASGRE+ASZRE+ATGRE+ATZRE+A4ARE
2140 AWWAIM=ASGIM+ASZIM+ATGIM+ATZIM+A4AIM
2141 AWWSRE=ATGRE+ATZRE+AUGRE+AUZRE+A4SRE
2142 AWWSIM=ATGIM+ATZIM+AUGIM+AUZIM+A4SIM
2143 ENDIF
2144 AWWA2=AWWARE**2+AWWAIM**2
2145 AWWS2=AWWSRE**2+AWWSIM**2
2146
2147 ELSE
2148C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron.
2149 FWWA=COMFAC*(AEM/(4.*PARU(1)*XW))**2*(64./9.)*
2150 & ABS(A00U+0.5*A20U+4.5*A11U*CTH)**2
2151 FWWS=COMFAC*(AEM/(4.*PARU(1)*XW))**2*64.*ABS(A20U)**2
2152 ENDIF
2153
2154 DO 930 I=MMIN1,MMAX1
2155 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 930
2156 EI=SIGN(1.,FLOAT(I))*KCHG(IABS(I),1)
2157 DO 920 J=MMIN2,MMAX2
2158 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 920
2159 EJ=SIGN(1.,FLOAT(J))*KCHG(IABS(J),1)
2160 IF(EI*EJ.LT.0.) THEN
2161C...W+W-
2162 IF(MSTP(45).EQ.1) GOTO 920
2163 IF(MSTP(46).LE.2) FACWW=FWW*AWWA2*WIDS(24,1)
2164 IF(MSTP(46).GE.3) FACWW=FWWA*WIDS(24,1)
2165 ELSE
2166C...W+W+/W-W-
2167 IF(MSTP(45).EQ.2) GOTO 920
2168 IF(MSTP(46).LE.2) FACWW=FWW*AWWS2
2169 IF(MSTP(46).GE.3) FACWW=FWWS
2170 IF(EI.GT.0.) FACWW=FACWW*VINT(91)
2171 IF(EI.LT.0.) FACWW=FACWW*VINT(92)
2172 ENDIF
2173 NCHN=NCHN+1
2174 ISIG(NCHN,1)=I
2175 ISIG(NCHN,2)=J
2176 ISIG(NCHN,3)=1
2177 SIGH(NCHN)=FACWW*VINT(180+I)*VINT(180+J)
2178 IF(EI*EJ.GT.0.) SIGH(NCHN)=0.5*SIGH(NCHN)
2179 920 CONTINUE
2180 930 CONTINUE
2181 940 CONTINUE
2182
2183 ELSEIF(ISUB.EQ.78) THEN
2184C...W+/- + H0 -> W+/- + H0.
2185
2186 ELSEIF(ISUB.EQ.79) THEN
2187C...H0 + H0 -> H0 + H0.
2188
2189 ELSEIF(ISUB.EQ.80) THEN
2190C...q + gamma -> q' + pi+/-.
2191 FQPI=COMFAC*(2.*AEM/9.)*(-SH/TH)*(1./SH2+1./TH2)
2192 ASSH=ULALPS(MAX(0.5,0.5*SH))
2193 Q2FPSH=0.55/LOG(MAX(2.,2.*SH))
2194 DELSH=UH*SQRT(ASSH*Q2FPSH)
2195 ASUH=ULALPS(MAX(0.5,-0.5*UH))
2196 Q2FPUH=0.55/LOG(MAX(2.,-2.*UH))
2197 DELUH=SH*SQRT(ASUH*Q2FPUH)
2198 DO 960 I=MAX(-2,MMINA),MIN(2,MMAXA)
2199 IF(I.EQ.0) GOTO 960
2200 EI=KCHG(IABS(I),1)/3.
2201 EJ=SIGN(1.-ABS(EI),EI)
2202 DO 950 ISDE=1,2
2203 IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 950
2204 IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 950
2205 NCHN=NCHN+1
2206 ISIG(NCHN,ISDE)=I
2207 ISIG(NCHN,3-ISDE)=22
2208 ISIG(NCHN,3)=1
2209 SIGH(NCHN)=FQPI*(EI*DELSH+EJ*DELUH)**2
2210 950 CONTINUE
2211 960 CONTINUE
2212
2213 ENDIF
2214
2215C...C: 2 -> 2, tree diagrams with masses.
2216
2217 ELSEIF(ISUB.LE.90) THEN
2218 IF(ISUB.EQ.81) THEN
2219C...q + q~ -> Q + Q~.
2220 FACQQB=COMFAC*AS**2*4./9.*(((TH-SQM3)**2+
2221 & (UH-SQM3)**2)/SH2+2.*SQM3/SH)
2222 IF(MSTP(35).GE.1) FACQQB=FACQQB*PYHFTH(SH,SQM3,0.)
2223 WID2=1.
2224 IF(MINT(55).EQ.6.AND.MSTP(48).GE.1) WID2=WIDS(26,1)
2225 IF((MINT(55).EQ.7.OR.MINT(55).EQ.8).AND.MSTP(49).GE.1)
2226 & WID2=WIDS(MINT(55)+20,1)
2227 FACQQB=FACQQB*WID2
2228 DO 970 I=MMINA,MMAXA
2229 IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
2230 & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 970
2231 NCHN=NCHN+1
2232 ISIG(NCHN,1)=I
2233 ISIG(NCHN,2)=-I
2234 ISIG(NCHN,3)=1
2235 SIGH(NCHN)=FACQQB
2236 970 CONTINUE
2237
2238 ELSEIF(ISUB.EQ.82) THEN
2239C...g + g -> Q + Q~.
2240 IF(MSTP(34).EQ.0) THEN
2241 FACQQ1=COMFAC*FACA*AS**2*(1./6.)*((UH-SQM3)/(TH-SQM3)-
2242 & 2.*(UH-SQM3)**2/SH2+4.*(SQM3/SH)*(TH*UH-SQM3**2)/
2243 & (TH-SQM3)**2)
2244 FACQQ2=COMFAC*FACA*AS**2*(1./6.)*((TH-SQM3)/(UH-SQM3)-
2245 & 2.*(TH-SQM3)**2/SH2+4.*(SQM3/SH)*(TH*UH-SQM3**2)/
2246 & (UH-SQM3)**2)
2247 ELSE
2248 FACQQ1=COMFAC*FACA*AS**2*(1./6.)*((UH-SQM3)/(TH-SQM3)-
2249 & 2.25*(UH-SQM3)**2/SH2+4.5*(SQM3/SH)*(TH*UH-SQM3**2)/
2250 & (TH-SQM3)**2+0.5*SQM3*TH/(TH-SQM3)**2-SQM3**2/(SH*(TH-SQM3)))
2251 FACQQ2=COMFAC*FACA*AS**2*(1./6.)*((TH-SQM3)/(UH-SQM3)-
2252 & 2.25*(TH-SQM3)**2/SH2+4.5*(SQM3/SH)*(TH*UH-SQM3**2)/
2253 & (UH-SQM3)**2+0.5*SQM3*UH/(UH-SQM3)**2-SQM3**2/(SH*(UH-SQM3)))
2254 ENDIF
2255 IF(MSTP(35).GE.1) THEN
2256 FATRE=PYHFTH(SH,SQM3,2./7.)
2257 FACQQ1=FACQQ1*FATRE
2258 FACQQ2=FACQQ2*FATRE
2259 ENDIF
2260 WID2=1.
2261 IF(MINT(55).EQ.6.AND.MSTP(48).GE.1) WID2=WIDS(26,1)
2262 IF((MINT(55).EQ.7.OR.MINT(55).EQ.8).AND.MSTP(49).GE.1)
2263 & WID2=WIDS(MINT(55)+20,1)
2264 FACQQ1=FACQQ1*WID2
2265 FACQQ2=FACQQ2*WID2
2266 IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 980
2267 NCHN=NCHN+1
2268 ISIG(NCHN,1)=21
2269 ISIG(NCHN,2)=21
2270 ISIG(NCHN,3)=1
2271 SIGH(NCHN)=FACQQ1
2272 NCHN=NCHN+1
2273 ISIG(NCHN,1)=21
2274 ISIG(NCHN,2)=21
2275 ISIG(NCHN,3)=2
2276 SIGH(NCHN)=FACQQ2
2277 980 CONTINUE
2278
2279 ELSEIF(ISUB.EQ.83) THEN
2280C...f + q -> f' + Q.
2281 FACQQS=COMFAC*(0.5*AEM/XW)**2*SH*(SH-SQM3)/(SQMW-TH)**2
2282 FACQQU=COMFAC*(0.5*AEM/XW)**2*UH*(UH-SQM3)/(SQMW-TH)**2
2283 DO 1000 I=MMIN1,MMAX1
2284 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 1000
2285 DO 990 J=MMIN2,MMAX2
2286 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 990
2287 IF(I*J.GT.0.AND.MOD(IABS(I+J),2).EQ.0) GOTO 990
2288 IF(I*J.LT.0.AND.MOD(IABS(I+J),2).EQ.1) GOTO 990
2289 IF(IABS(I).LT.MINT(55).AND.MOD(IABS(I+MINT(55)),2).EQ.1) THEN
2290 NCHN=NCHN+1
2291 ISIG(NCHN,1)=I
2292 ISIG(NCHN,2)=J
2293 ISIG(NCHN,3)=1
2294 IF(MOD(MINT(55),2).EQ.0) FACCKM=VCKM(MINT(55)/2,
2295 & (IABS(I)+1)/2)*VINT(180+J)
2296 IF(MOD(MINT(55),2).EQ.1) FACCKM=VCKM(IABS(I)/2,
2297 & (MINT(55)+1)/2)*VINT(180+J)
2298 WID2=1.
2299 IF(I.GT.0) THEN
2300 IF(MINT(55).EQ.6.AND.MSTP(48).GE.1) WID2=WIDS(26,2)
2301 IF((MINT(55).EQ.7.OR.MINT(55).EQ.8).AND.MSTP(49).GE.1)
2302 & WID2=WIDS(MINT(55)+20,2)
2303 ELSE
2304 IF(MINT(55).EQ.6.AND.MSTP(48).GE.1) WID2=WIDS(26,3)
2305 IF((MINT(55).EQ.7.OR.MINT(55).EQ.8).AND.MSTP(49).GE.1)
2306 & WID2=WIDS(MINT(55)+20,3)
2307 ENDIF
2308 IF(I*J.GT.0) SIGH(NCHN)=FACQQS*FACCKM*WID2
2309 IF(I*J.LT.0) SIGH(NCHN)=FACQQU*FACCKM*WID2
2310 ENDIF
2311 IF(IABS(J).LT.MINT(55).AND.MOD(IABS(J+MINT(55)),2).EQ.1) THEN
2312 NCHN=NCHN+1
2313 ISIG(NCHN,1)=I
2314 ISIG(NCHN,2)=J
2315 ISIG(NCHN,3)=2
2316 IF(MOD(MINT(55),2).EQ.0) FACCKM=VCKM(MINT(55)/2,
2317 & (IABS(J)+1)/2)*VINT(180+I)
2318 IF(MOD(MINT(55),2).EQ.1) FACCKM=VCKM(IABS(J)/2,
2319 & (MINT(55)+1)/2)*VINT(180+I)
2320 IF(J.GT.0) THEN
2321 IF(MINT(55).EQ.6.AND.MSTP(48).GE.1) WID2=WIDS(26,2)
2322 IF((MINT(55).EQ.7.OR.MINT(55).EQ.8).AND.MSTP(49).GE.1)
2323 & WID2=WIDS(MINT(55)+20,2)
2324 ELSE
2325 IF(MINT(55).EQ.6.AND.MSTP(48).GE.1) WID2=WIDS(26,3)
2326 IF((MINT(55).EQ.7.OR.MINT(55).EQ.8).AND.MSTP(49).GE.1)
2327 & WID2=WIDS(MINT(55)+20,3)
2328 ENDIF
2329 IF(I*J.GT.0) SIGH(NCHN)=FACQQS*FACCKM*WID2
2330 IF(I*J.LT.0) SIGH(NCHN)=FACQQU*FACCKM*WID2
2331 ENDIF
2332 990 CONTINUE
2333 1000 CONTINUE
2334
2335 ELSEIF(ISUB.EQ.84) THEN
2336C...g + gamma -> Q + Q~.
2337 FMTU=SQM3/(SQM3-TH)+SQM3/(SQM3-UH)
2338 FACQQ=COMFAC*AS*AEM*(KCHG(IABS(MINT(55)),1)/3.)**2*
2339 & ((SQM3-TH)/(SQM3-UH)+(SQM3-UH)/(SQM3-TH)+4.*FMTU*(1.-FMTU))
2340 IF(MSTP(35).GE.1) FACQQ=FACQQ*PYHFTH(SH,SQM3,0.)
2341 WID2=1.
2342 IF(MINT(55).EQ.6.AND.MSTP(48).GE.1) WID2=WIDS(26,1)
2343 IF((MINT(55).EQ.7.OR.MINT(55).EQ.8).AND.MSTP(49).GE.1)
2344 & WID2=WIDS(MINT(55)+20,1)
2345 FACQQ=FACQQ*WID2
2346 IF(KFAC(1,21)*KFAC(2,22).NE.0) THEN
2347 NCHN=NCHN+1
2348 ISIG(NCHN,1)=21
2349 ISIG(NCHN,2)=22
2350 ISIG(NCHN,3)=1
2351 SIGH(NCHN)=FACQQ
2352 ENDIF
2353 IF(KFAC(1,22)*KFAC(2,21).NE.0) THEN
2354 NCHN=NCHN+1
2355 ISIG(NCHN,1)=22
2356 ISIG(NCHN,2)=21
2357 ISIG(NCHN,3)=1
2358 SIGH(NCHN)=FACQQ
2359 ENDIF
2360
2361 ELSEIF(ISUB.EQ.85) THEN
2362C...gamma + gamma -> F + F~ (heavy fermion, quark or lepton).
2363 FMTU=SQM3/(SQM3-TH)+SQM3/(SQM3-UH)
2364 FACFF=COMFAC*AEM**2*(KCHG(IABS(MINT(56)),1)/3.)**4*2.*
2365 & ((SQM3-TH)/(SQM3-UH)+(SQM3-UH)/(SQM3-TH)+4.*FMTU*(1.-FMTU))
2366 IF(IABS(MINT(56)).LT.10) FACFF=3.*FACFF
2367 IF(IABS(MINT(56)).LT.10.AND.MSTP(35).GE.1)
2368 & FACFF=FACFF*PYHFTH(SH,SQM3,1.)
2369 WID2=1.
2370 IF(MINT(56).EQ.6.AND.MSTP(48).GE.1) WID2=WIDS(26,1)
2371 IF((MINT(56).EQ.7.OR.MINT(56).EQ.8).AND.MSTP(49).GE.1)
2372 & WID2=WIDS(MINT(56)+20,1)
2373 IF(MINT(56).EQ.17.AND.MSTP(49).GE.1) WID2=WIDS(29,1)
2374 FACFF=FACFF*WID2
2375 IF(KFAC(1,22)*KFAC(2,22).NE.0) THEN
2376 NCHN=NCHN+1
2377 ISIG(NCHN,1)=22
2378 ISIG(NCHN,2)=22
2379 ISIG(NCHN,3)=1
2380 SIGH(NCHN)=FACFF
2381 ENDIF
2382
2383 ELSEIF(ISUB.EQ.86) THEN
2384C...g + g -> J/Psi + g.
2385 FACQQG=COMFAC*AS**3*(5./9.)*PARP(38)*SQRT(SQM3)*
2386 & (((SH*(SH-SQM3))**2+(TH*(TH-SQM3))**2+(UH*(UH-SQM3))**2)/
2387 & ((TH-SQM3)*(UH-SQM3))**2)/(SH-SQM3)**2
2388 IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN
2389 NCHN=NCHN+1
2390 ISIG(NCHN,1)=21
2391 ISIG(NCHN,2)=21
2392 ISIG(NCHN,3)=1
2393 SIGH(NCHN)=FACQQG
2394 ENDIF
2395
2396 ELSEIF(ISUB.EQ.87) THEN
2397C...g + g -> chi_0c + g.
2398 PGTW=(SH*TH+TH*UH+UH*SH)/SH2
2399 QGTW=(SH*TH*UH)/SH**3
2400 RGTW=SQM3/SH
2401 FACQQG=COMFAC*AS**3*4.*(PARP(39)/SQRT(SQM3))*(1./SH)*
2402 & (9.*RGTW**2*PGTW**4*(RGTW**4-2.*RGTW**2*PGTW+PGTW**2)-
2403 & 6.*RGTW*PGTW**3*QGTW*(2.*RGTW**4-5.*RGTW**2*PGTW+PGTW**2)-
2404 & PGTW**2*QGTW**2*(RGTW**4+2.*RGTW**2*PGTW-PGTW**2)+
2405 & 2.*RGTW*PGTW*QGTW**3*(RGTW**2-PGTW)+6.*RGTW**2*QGTW**4)/
2406 & (QGTW*(QGTW-RGTW*PGTW)**4)
2407 IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN
2408 NCHN=NCHN+1
2409 ISIG(NCHN,1)=21
2410 ISIG(NCHN,2)=21
2411 ISIG(NCHN,3)=1
2412 SIGH(NCHN)=FACQQG
2413 ENDIF
2414
2415 ELSEIF(ISUB.EQ.88) THEN
2416C...g + g -> chi_1c + g.
2417 PGTW=(SH*TH+TH*UH+UH*SH)/SH2
2418 QGTW=(SH*TH*UH)/SH**3
2419 RGTW=SQM3/SH
2420 FACQQG=COMFAC*AS**3*12.*(PARP(39)/SQRT(SQM3))*(1./SH)*
2421 & PGTW**2*(RGTW*PGTW**2*(RGTW**2-4.*PGTW)+2.*QGTW*(-RGTW**4+
2422 & 5.*RGTW**2*PGTW+PGTW**2)-15.*RGTW*QGTW**2)/
2423 & (QGTW-RGTW*PGTW)**4
2424 IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN
2425 NCHN=NCHN+1
2426 ISIG(NCHN,1)=21
2427 ISIG(NCHN,2)=21
2428 ISIG(NCHN,3)=1
2429 SIGH(NCHN)=FACQQG
2430 ENDIF
2431
2432 ELSEIF(ISUB.EQ.89) THEN
2433C...g + g -> chi_2c + g.
2434 PGTW=(SH*TH+TH*UH+UH*SH)/SH2
2435 QGTW=(SH*TH*UH)/SH**3
2436 RGTW=SQM3/SH
2437 FACQQG=COMFAC*AS**3*4.*(PARP(39)/SQRT(SQM3))*(1./SH)*
2438 & (12.*RGTW**2*PGTW**4*(RGTW**4-2.*RGTW**2*PGTW+PGTW**2)-
2439 & 3.*RGTW*PGTW**3*QGTW*(8.*RGTW**4-RGTW**2*PGTW+4.*PGTW**2)+
2440 & 2.*PGTW**2*QGTW**2*(-7.*RGTW**4+43.*RGTW**2*PGTW+PGTW**2)+
2441 & RGTW*PGTW*QGTW**3*(16.*RGTW**2-61.*PGTW)+12.*RGTW**2*QGTW**4)/
2442 & (QGTW*(QGTW-RGTW*PGTW)**4)
2443 IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN
2444 NCHN=NCHN+1
2445 ISIG(NCHN,1)=21
2446 ISIG(NCHN,2)=21
2447 ISIG(NCHN,3)=1
2448 SIGH(NCHN)=FACQQG
2449 ENDIF
2450 ENDIF
2451
2452C...D: Mimimum bias processes.
2453
2454 ELSEIF(ISUB.LE.100) THEN
2455 IF(ISUB.EQ.91) THEN
2456C...Elastic scattering.
2457 SIGS=SIGT(0,0,1)
2458
2459 ELSEIF(ISUB.EQ.92) THEN
2460C...Single diffractive scattering (first side, i.e. XB).
2461 SIGS=SIGT(0,0,2)
2462
2463 ELSEIF(ISUB.EQ.93) THEN
2464C...Single diffractive scattering (second side, i.e. AX).
2465 SIGS=SIGT(0,0,3)
2466
2467 ELSEIF(ISUB.EQ.94) THEN
2468C...Double diffractive scattering.
2469 SIGS=SIGT(0,0,4)
2470
2471 ELSEIF(ISUB.EQ.95) THEN
2472C...Low-pT scattering.
2473 SIGS=SIGT(0,0,5)
2474
2475 ELSEIF(ISUB.EQ.96) THEN
2476C...Multiple interactions: sum of QCD processes.
2477 CALL PYWIDT(21,SH,WDTP,WDTE)
2478
2479C...q + q' -> q + q'.
2480 FACQQ1=COMFAC*AS**2*4./9.*(SH2+UH2)/TH2
2481 FACQQB=COMFAC*AS**2*4./9.*((SH2+UH2)/TH2*FACA-
2482 & MSTP(34)*2./3.*UH2/(SH*TH))
2483 FACQQ2=COMFAC*AS**2*4./9.*((SH2+TH2)/UH2-
2484 & MSTP(34)*2./3.*SH2/(TH*UH))
2485 DO 1020 I=-3,3
2486 IF(I.EQ.0) GOTO 1020
2487 DO 1010 J=-3,3
2488 IF(J.EQ.0) GOTO 1010
2489 NCHN=NCHN+1
2490 ISIG(NCHN,1)=I
2491 ISIG(NCHN,2)=J
2492 ISIG(NCHN,3)=111
2493 SIGH(NCHN)=FACQQ1
2494 IF(I.EQ.-J) SIGH(NCHN)=FACQQB
2495 IF(I.EQ.J) THEN
2496 SIGH(NCHN)=0.5*SIGH(NCHN)
2497 NCHN=NCHN+1
2498 ISIG(NCHN,1)=I
2499 ISIG(NCHN,2)=J
2500 ISIG(NCHN,3)=112
2501 SIGH(NCHN)=0.5*FACQQ2
2502 ENDIF
2503 1010 CONTINUE
2504 1020 CONTINUE
2505
2506C...q + q~ -> q' + q~' or g + g.
2507 FACQQB=COMFAC*AS**2*4./9.*(TH2+UH2)/SH2*(WDTE(0,1)+WDTE(0,2)+
2508 & WDTE(0,3)+WDTE(0,4))
2509 FACGG1=COMFAC*AS**2*32./27.*(UH/TH-(2.+MSTP(34)*1./4.)*UH2/SH2)
2510 FACGG2=COMFAC*AS**2*32./27.*(TH/UH-(2.+MSTP(34)*1./4.)*TH2/SH2)
2511 DO 1030 I=-3,3
2512 IF(I.EQ.0) GOTO 1030
2513 NCHN=NCHN+1
2514 ISIG(NCHN,1)=I
2515 ISIG(NCHN,2)=-I
2516 ISIG(NCHN,3)=121
2517 SIGH(NCHN)=FACQQB
2518 NCHN=NCHN+1
2519 ISIG(NCHN,1)=I
2520 ISIG(NCHN,2)=-I
2521 ISIG(NCHN,3)=131
2522 SIGH(NCHN)=0.5*FACGG1
2523 NCHN=NCHN+1
2524 ISIG(NCHN,1)=I
2525 ISIG(NCHN,2)=-I
2526 ISIG(NCHN,3)=132
2527 SIGH(NCHN)=0.5*FACGG2
2528 1030 CONTINUE
2529
2530C...q + g -> q + g.
2531 FACQG1=COMFAC*AS**2*4./9.*((2.+MSTP(34)*1./4.)*UH2/TH2-UH/SH)*
2532 & FACA
2533 FACQG2=COMFAC*AS**2*4./9.*((2.+MSTP(34)*1./4.)*SH2/TH2-SH/UH)
2534 DO 1050 I=-3,3
2535 IF(I.EQ.0) GOTO 1050
2536 DO 1040 ISDE=1,2
2537 NCHN=NCHN+1
2538 ISIG(NCHN,ISDE)=I
2539 ISIG(NCHN,3-ISDE)=21
2540 ISIG(NCHN,3)=281
2541 SIGH(NCHN)=FACQG1
2542 NCHN=NCHN+1
2543 ISIG(NCHN,ISDE)=I
2544 ISIG(NCHN,3-ISDE)=21
2545 ISIG(NCHN,3)=282
2546 SIGH(NCHN)=FACQG2
2547 1040 CONTINUE
2548 1050 CONTINUE
2549
2550C...g + g -> q + q~ or g + g.
2551 FACQQ1=COMFAC*AS**2*1./6.*(UH/TH-(2.+MSTP(34)*1./4.)*UH2/SH2)*
2552 & (WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))*FACA
2553 FACQQ2=COMFAC*AS**2*1./6.*(TH/UH-(2.+MSTP(34)*1./4.)*TH2/SH2)*
2554 & (WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))*FACA
2555 FACGG1=COMFAC*AS**2*9./4.*(SH2/TH2+2.*SH/TH+3.+2.*TH/SH+
2556 & TH2/SH2)*FACA
2557 FACGG2=COMFAC*AS**2*9./4.*(UH2/SH2+2.*UH/SH+3.+2.*SH/UH+
2558 & SH2/UH2)*FACA
2559 FACGG3=COMFAC*AS**2*9./4.*(TH2/UH2+2.*TH/UH+3+2.*UH/TH+UH2/TH2)
2560 NCHN=NCHN+1
2561 ISIG(NCHN,1)=21
2562 ISIG(NCHN,2)=21
2563 ISIG(NCHN,3)=531
2564 SIGH(NCHN)=FACQQ1
2565 NCHN=NCHN+1
2566 ISIG(NCHN,1)=21
2567 ISIG(NCHN,2)=21
2568 ISIG(NCHN,3)=532
2569 SIGH(NCHN)=FACQQ2
2570 NCHN=NCHN+1
2571 ISIG(NCHN,1)=21
2572 ISIG(NCHN,2)=21
2573 ISIG(NCHN,3)=681
2574 SIGH(NCHN)=0.5*FACGG1
2575 NCHN=NCHN+1
2576 ISIG(NCHN,1)=21
2577 ISIG(NCHN,2)=21
2578 ISIG(NCHN,3)=682
2579 SIGH(NCHN)=0.5*FACGG2
2580 NCHN=NCHN+1
2581 ISIG(NCHN,1)=21
2582 ISIG(NCHN,2)=21
2583 ISIG(NCHN,3)=683
2584 SIGH(NCHN)=0.5*FACGG3
2585 ENDIF
2586
2587C...E: 2 -> 1, loop diagrams.
2588
2589 ELSEIF(ISUB.LE.110) THEN
2590 IF(ISUB.EQ.101) THEN
2591C...g + g -> gamma*/Z0.
2592
2593 ELSEIF(ISUB.EQ.102) THEN
2594C...g + g -> H0 (or H'0, or A0).
2595 CALL PYWIDT(KFHIGG,SH,WDTP,WDTE)
2596 HP=AEM/(8.*XW)*SH/SQMW*SH
2597 HS=HP*WDTP(0)
2598 HF=HP*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
2599 FACBW=4.*COMFAC/((SH-SQMH)**2+HS**2)
2600 IF(ABS(SH-SQMH).GT.100.*HS) FACBW=0.
2601 HI=HP*WDTP(13)/32.
2602 IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 1060
2603 NCHN=NCHN+1
2604 ISIG(NCHN,1)=21
2605 ISIG(NCHN,2)=21
2606 ISIG(NCHN,3)=1
2607 SIGH(NCHN)=HI*FACBW*HF
2608 1060 CONTINUE
2609
2610 ELSEIF(ISUB.EQ.103) THEN
2611C...gamma + gamma -> H0 (or H'0, or A0).
2612 CALL PYWIDT(KFHIGG,SH,WDTP,WDTE)
2613 HP=AEM/(8.*XW)*SH/SQMW*SH
2614 HS=HP*WDTP(0)
2615 HF=HP*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
2616 FACBW=4.*COMFAC/((SH-SQMH)**2+HS**2)
2617 IF(ABS(SH-SQMH).GT.100.*HS) FACBW=0.
2618 HI=HP*WDTP(14)*2.
2619 IF(KFAC(1,22)*KFAC(2,22).EQ.0) GOTO 1070
2620 NCHN=NCHN+1
2621 ISIG(NCHN,1)=22
2622 ISIG(NCHN,2)=22
2623 ISIG(NCHN,3)=1
2624 SIGH(NCHN)=HI*FACBW*HF
2625 1070 CONTINUE
2626
2627C...F: 2 -> 2, box diagrams.
2628
2629 ELSEIF(ISUB.EQ.110) THEN
2630C...f + f~ -> gamma + H0.
2631 THUH=MAX(TH*UH,SH*CKIN(3)**2)
2632 FACHG=COMFAC*(3.*AEM**4)/(2.*PARU(1)**2*XW*SQMW)*SH*THUH
2633 FACHG=FACHG*WIDS(KFHIGG,2)
2634C...Calculate loop contributions for intermediate gamma* and Z0.
2635 CIGTOT=CMPLX(0.,0.)
2636 CIZTOT=CMPLX(0.,0.)
2637 JMAX=3*MSTP(1)+1
2638 DO 1080 J=1,JMAX
2639 IF(J.LE.2*MSTP(1)) THEN
2640 FNC=1.
2641 EJ=KCHG(J,1)/3.
2642 AJ=SIGN(1.,EJ+0.1)
2643 VJ=AJ-4.*EJ*XWV
2644 BALP=SQM4/(2.*PMAS(J,1))**2
2645 BBET=SH/(2.*PMAS(J,1))**2
2646 ELSEIF(J.LE.3*MSTP(1)) THEN
2647 FNC=3.
2648 JL=2*(J-2*MSTP(1))-1
2649 EJ=KCHG(10+JL,1)/3.
2650 AJ=SIGN(1.,EJ+0.1)
2651 VJ=AJ-4.*EJ*XWV
2652 BALP=SQM4/(2.*PMAS(10+JL,1))**2
2653 BBET=SH/(2.*PMAS(10+JL,1))**2
2654 ELSE
2655 BALP=SQM4/(2.*PMAS(24,1))**2
2656 BBET=SH/(2.*PMAS(24,1))**2
2657 ENDIF
2658 BABI=1./(BALP-BBET)
2659 IF(BALP.LT.1.) THEN
2660 F0ALP=CMPLX(ASIN(SQRT(BALP)),0.)
2661 F1ALP=F0ALP**2
2662 ELSE
2663 F0ALP=CMPLX(LOG(SQRT(BALP)+SQRT(BALP-1.)),-0.5*PARU(1))
2664 F1ALP=-F0ALP**2
2665 ENDIF
2666 F2ALP=SQRT(ABS(BALP-1.)/BALP)*F0ALP
2667 IF(BBET.LT.1.) THEN
2668 F0BET=CMPLX(ASIN(SQRT(BBET)),0.)
2669 F1BET=F0BET**2
2670 ELSE
2671 F0BET=CMPLX(LOG(SQRT(BBET)+SQRT(BBET-1.)),-0.5*PARU(1))
2672 F1BET=-F0BET**2
2673 ENDIF
2674 F2BET=SQRT(ABS(BBET-1.)/BBET)*F0BET
2675 IF(J.LE.3*MSTP(1)) THEN
2676 FIF=0.5*BABI+BABI**2*(0.5*(1.-BALP+BBET)*(F1BET-F1ALP)+
2677 & BBET*(F2BET-F2ALP))
2678 CIGTOT=CIGTOT+FNC*EJ**2*FIF
2679 CIZTOT=CIZTOT+FNC*EJ*VJ*FIF
2680 ELSE
2681 TXW=XW/XW1
2682 CIGTOT=CIGTOT-0.5*(BABI*(1.5+BALP)+BABI**2*((1.5-3.*BALP+
2683 & 4.*BBET)*(F1BET-F1ALP)+BBET*(2.*BALP+3.)*(F2BET-F2ALP)))
2684 CIZTOT=CIZTOT-0.5*BABI*XW1*((5.-TXW+2.*BALP*(1.-TXW))*
2685 & (1.+2.*BABI*BBET*(F2BET-F2ALP))+BABI*(4.*BBET*(3.-TXW)-
2686 & (2.*BALP-1.)*(5.-TXW))*(F1BET-F1ALP))
2687 ENDIF
2688 1080 CONTINUE
2689 GMMZ=PMAS(23,1)*PMAS(23,2)
2690 CIGTOT=CIGTOT/SH
2691 CIZTOT=CIZTOT*XWC/CMPLX(SH-SQMZ,GMMZ)
2692C...Loop over initial flavours.
2693 DO 1090 I=MMINA,MMAXA
2694 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1090
2695 EI=KCHG(IABS(I),1)/3.
2696 AI=SIGN(1.,EI)
2697 VI=AI-4.*EI*XWV
2698 FCOI=1.
2699 IF(IABS(I).LE.10) FCOI=FACA/3.
2700 NCHN=NCHN+1
2701 ISIG(NCHN,1)=I
2702 ISIG(NCHN,2)=-I
2703 ISIG(NCHN,3)=1
2704 SIGH(NCHN)=FACHG*FCOI*(ABS(EI*CIGTOT+VI*CIZTOT)**2+
2705 & ABS(AI*CIZTOT)**2)
2706 1090 CONTINUE
2707
2708 ENDIF
2709
2710 ELSEIF(ISUB.LE.120) THEN
2711 IF(ISUB.EQ.111) THEN
2712C...f + f~ -> g + H0 (q + q~ -> g + H0 only).
2713 A5STUR=0.
2714 A5STUI=0.
2715 DO 1100 I=1,2*MSTP(1)
2716 SQMQ=PMAS(I,1)**2
2717 EPSS=4.*SQMQ/SH
2718 EPSH=4.*SQMQ/SQMH
2719 CALL PYWAUX(1,EPSS,W1SR,W1SI)
2720 CALL PYWAUX(1,EPSH,W1HR,W1HI)
2721 CALL PYWAUX(2,EPSS,W2SR,W2SI)
2722 CALL PYWAUX(2,EPSH,W2HR,W2HI)
2723 A5STUR=A5STUR+EPSH*(1.+SH/(TH+UH)*(W1SR-W1HR)+
2724 & (0.25-SQMQ/(TH+UH))*(W2SR-W2HR))
2725 A5STUI=A5STUI+EPSH*(SH/(TH+UH)*(W1SI-W1HI)+
2726 & (0.25-SQMQ/(TH+UH))*(W2SI-W2HI))
2727 1100 CONTINUE
2728 FACGH=COMFAC*FACA/(144.*PARU(1)**2)*AEM/XW*AS**3*SQMH/SQMW*
2729 & SQMH/SH*(UH**2+TH**2)/(UH+TH)**2*(A5STUR**2+A5STUI**2)
2730 FACGH=FACGH*WIDS(25,2)
2731 DO 1110 I=MMINA,MMAXA
2732 IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
2733 & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1110
2734 NCHN=NCHN+1
2735 ISIG(NCHN,1)=I
2736 ISIG(NCHN,2)=-I
2737 ISIG(NCHN,3)=1
2738 SIGH(NCHN)=FACGH
2739 1110 CONTINUE
2740
2741 ELSEIF(ISUB.EQ.112) THEN
2742C...f + g -> f + H0 (q + g -> q + H0 only).
2743 A5TSUR=0.
2744 A5TSUI=0.
2745 DO 1120 I=1,2*MSTP(1)
2746 SQMQ=PMAS(I,1)**2
2747 EPST=4.*SQMQ/TH
2748 EPSH=4.*SQMQ/SQMH
2749 CALL PYWAUX(1,EPST,W1TR,W1TI)
2750 CALL PYWAUX(1,EPSH,W1HR,W1HI)
2751 CALL PYWAUX(2,EPST,W2TR,W2TI)
2752 CALL PYWAUX(2,EPSH,W2HR,W2HI)
2753 A5TSUR=A5TSUR+EPSH*(1.+TH/(SH+UH)*(W1TR-W1HR)+
2754 & (0.25-SQMQ/(SH+UH))*(W2TR-W2HR))
2755 A5TSUI=A5TSUI+EPSH*(TH/(SH+UH)*(W1TI-W1HI)+
2756 & (0.25-SQMQ/(SH+UH))*(W2TI-W2HI))
2757 1120 CONTINUE
2758 FACQH=COMFAC*FACA/(384.*PARU(1)**2)*AEM/XW*AS**3*SQMH/SQMW*
2759 & SQMH/(-TH)*(UH**2+SH**2)/(UH+SH)**2*(A5TSUR**2+A5TSUI**2)
2760 FACQH=FACQH*WIDS(25,2)
2761 DO 1140 I=MMINA,MMAXA
2762 IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 1140
2763 DO 1130 ISDE=1,2
2764 IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 1130
2765 IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 1130
2766 NCHN=NCHN+1
2767 ISIG(NCHN,ISDE)=I
2768 ISIG(NCHN,3-ISDE)=21
2769 ISIG(NCHN,3)=1
2770 SIGH(NCHN)=FACQH
2771 1130 CONTINUE
2772 1140 CONTINUE
2773
2774 ELSEIF(ISUB.EQ.113) THEN
2775C...g + g -> g + H0.
2776 A2STUR=0.
2777 A2STUI=0.
2778 A2USTR=0.
2779 A2USTI=0.
2780 A2TUSR=0.
2781 A2TUSI=0.
2782 A4STUR=0.
2783 A4STUI=0.
2784 DO 1150 I=1,2*MSTP(1)
2785 SQMQ=PMAS(I,1)**2
2786 EPSS=4.*SQMQ/SH
2787 EPST=4.*SQMQ/TH
2788 EPSU=4.*SQMQ/UH
2789 EPSH=4.*SQMQ/SQMH
2790 IF(EPSH.LT.1.E-6) GOTO 1150
2791 CALL PYWAUX(1,EPSS,W1SR,W1SI)
2792 CALL PYWAUX(1,EPST,W1TR,W1TI)
2793 CALL PYWAUX(1,EPSU,W1UR,W1UI)
2794 CALL PYWAUX(1,EPSH,W1HR,W1HI)
2795 CALL PYWAUX(2,EPSS,W2SR,W2SI)
2796 CALL PYWAUX(2,EPST,W2TR,W2TI)
2797 CALL PYWAUX(2,EPSU,W2UR,W2UI)
2798 CALL PYWAUX(2,EPSH,W2HR,W2HI)
2799 CALL PYI3AU(EPSS,TH/UH,Y3STUR,Y3STUI)
2800 CALL PYI3AU(EPSS,UH/TH,Y3SUTR,Y3SUTI)
2801 CALL PYI3AU(EPST,SH/UH,Y3TSUR,Y3TSUI)
2802 CALL PYI3AU(EPST,UH/SH,Y3TUSR,Y3TUSI)
2803 CALL PYI3AU(EPSU,SH/TH,Y3USTR,Y3USTI)
2804 CALL PYI3AU(EPSU,TH/SH,Y3UTSR,Y3UTSI)
2805 CALL PYI3AU(EPSH,SQMH/SH*TH/UH,YHSTUR,YHSTUI)
2806 CALL PYI3AU(EPSH,SQMH/SH*UH/TH,YHSUTR,YHSUTI)
2807 CALL PYI3AU(EPSH,SQMH/TH*SH/UH,YHTSUR,YHTSUI)
2808 CALL PYI3AU(EPSH,SQMH/TH*UH/SH,YHTUSR,YHTUSI)
2809 CALL PYI3AU(EPSH,SQMH/UH*SH/TH,YHUSTR,YHUSTI)
2810 CALL PYI3AU(EPSH,SQMH/UH*TH/SH,YHUTSR,YHUTSI)
2811 W3STUR=YHSTUR-Y3STUR-Y3UTSR
2812 W3STUI=YHSTUI-Y3STUI-Y3UTSI
2813 W3SUTR=YHSUTR-Y3SUTR-Y3TUSR
2814 W3SUTI=YHSUTI-Y3SUTI-Y3TUSI
2815 W3TSUR=YHTSUR-Y3TSUR-Y3USTR
2816 W3TSUI=YHTSUI-Y3TSUI-Y3USTI
2817 W3TUSR=YHTUSR-Y3TUSR-Y3SUTR
2818 W3TUSI=YHTUSI-Y3TUSI-Y3SUTI
2819 W3USTR=YHUSTR-Y3USTR-Y3TSUR
2820 W3USTI=YHUSTI-Y3USTI-Y3TSUI
2821 W3UTSR=YHUTSR-Y3UTSR-Y3STUR
2822 W3UTSI=YHUTSI-Y3UTSI-Y3STUI
2823 B2STUR=SQMQ/SQMH**2*(SH*(UH-SH)/(SH+UH)+2.*TH*UH*(UH+2.*SH)/
2824 & (SH+UH)**2*(W1TR-W1HR)+(SQMQ-SH/4.)*(0.5*W2SR+0.5*W2HR-W2TR+
2825 & W3STUR)+SH2*(2.*SQMQ/(SH+UH)**2-0.5/(SH+UH))*(W2TR-W2HR)+
2826 & 0.5*TH*UH/SH*(W2HR-2.*W2TR)+0.125*(SH-12.*SQMQ-4.*TH*UH/SH)*
2827 & W3TSUR)
2828 B2STUI=SQMQ/SQMH**2*(2.*TH*UH*(UH+2.*SH)/(SH+UH)**2*
2829 & (W1TI-W1HI)+(SQMQ-SH/4.)*(0.5*W2SI+0.5*W2HI-W2TI+W3STUI)+
2830 & SH2*(2.*SQMQ/(SH+UH)**2-0.5/(SH+UH))*(W2TI-W2HI)+0.5*TH*UH/SH*
2831 & (W2HI-2.*W2TI)+0.125*(SH-12.*SQMQ-4.*TH*UH/SH)*W3TSUI)
2832 B2SUTR=SQMQ/SQMH**2*(SH*(TH-SH)/(SH+TH)+2.*UH*TH*(TH+2.*SH)/
2833 & (SH+TH)**2*(W1UR-W1HR)+(SQMQ-SH/4.)*(0.5*W2SR+0.5*W2HR-W2UR+
2834 & W3SUTR)+SH2*(2.*SQMQ/(SH+TH)**2-0.5/(SH+TH))*(W2UR-W2HR)+
2835 & 0.5*UH*TH/SH*(W2HR-2.*W2UR)+0.125*(SH-12.*SQMQ-4.*UH*TH/SH)*
2836 & W3USTR)
2837 B2SUTI=SQMQ/SQMH**2*(2.*UH*TH*(TH+2.*SH)/(SH+TH)**2*
2838 & (W1UI-W1HI)+(SQMQ-SH/4.)*(0.5*W2SI+0.5*W2HI-W2UI+W3SUTI)+
2839 & SH2*(2.*SQMQ/(SH+TH)**2-0.5/(SH+TH))*(W2UI-W2HI)+0.5*UH*TH/SH*
2840 & (W2HI-2.*W2UI)+0.125*(SH-12.*SQMQ-4.*UH*TH/SH)*W3USTI)
2841 B2TSUR=SQMQ/SQMH**2*(TH*(UH-TH)/(TH+UH)+2.*SH*UH*(UH+2.*TH)/
2842 & (TH+UH)**2*(W1SR-W1HR)+(SQMQ-TH/4.)*(0.5*W2TR+0.5*W2HR-W2SR+
2843 & W3TSUR)+TH2*(2.*SQMQ/(TH+UH)**2-0.5/(TH+UH))*(W2SR-W2HR)+
2844 & 0.5*SH*UH/TH*(W2HR-2.*W2SR)+0.125*(TH-12.*SQMQ-4.*SH*UH/TH)*
2845 & W3STUR)
2846 B2TSUI=SQMQ/SQMH**2*(2.*SH*UH*(UH+2.*TH)/(TH+UH)**2*
2847 & (W1SI-W1HI)+(SQMQ-TH/4.)*(0.5*W2TI+0.5*W2HI-W2SI+W3TSUI)+
2848 & TH2*(2.*SQMQ/(TH+UH)**2-0.5/(TH+UH))*(W2SI-W2HI)+0.5*SH*UH/TH*
2849 & (W2HI-2.*W2SI)+0.125*(TH-12.*SQMQ-4.*SH*UH/TH)*W3STUI)
2850 B2TUSR=SQMQ/SQMH**2*(TH*(SH-TH)/(TH+SH)+2.*UH*SH*(SH+2.*TH)/
2851 & (TH+SH)**2*(W1UR-W1HR)+(SQMQ-TH/4.)*(0.5*W2TR+0.5*W2HR-W2UR+
2852 & W3TUSR)+TH2*(2.*SQMQ/(TH+SH)**2-0.5/(TH+SH))*(W2UR-W2HR)+
2853 & 0.5*UH*SH/TH*(W2HR-2.*W2UR)+0.125*(TH-12.*SQMQ-4.*UH*SH/TH)*
2854 & W3UTSR)
2855 B2TUSI=SQMQ/SQMH**2*(2.*UH*SH*(SH+2.*TH)/(TH+SH)**2*
2856 & (W1UI-W1HI)+(SQMQ-TH/4.)*(0.5*W2TI+0.5*W2HI-W2UI+W3TUSI)+
2857 & TH2*(2.*SQMQ/(TH+SH)**2-0.5/(TH+SH))*(W2UI-W2HI)+0.5*UH*SH/TH*
2858 & (W2HI-2.*W2UI)+0.125*(TH-12.*SQMQ-4.*UH*SH/TH)*W3UTSI)
2859 B2USTR=SQMQ/SQMH**2*(UH*(TH-UH)/(UH+TH)+2.*SH*TH*(TH+2.*UH)/
2860 & (UH+TH)**2*(W1SR-W1HR)+(SQMQ-UH/4.)*(0.5*W2UR+0.5*W2HR-W2SR+
2861 & W3USTR)+UH2*(2.*SQMQ/(UH+TH)**2-0.5/(UH+TH))*(W2SR-W2HR)+
2862 & 0.5*SH*TH/UH*(W2HR-2.*W2SR)+0.125*(UH-12.*SQMQ-4.*SH*TH/UH)*
2863 & W3SUTR)
2864 B2USTI=SQMQ/SQMH**2*(2.*SH*TH*(TH+2.*UH)/(UH+TH)**2*
2865 & (W1SI-W1HI)+(SQMQ-UH/4.)*(0.5*W2UI+0.5*W2HI-W2SI+W3USTI)+
2866 & UH2*(2.*SQMQ/(UH+TH)**2-0.5/(UH+TH))*(W2SI-W2HI)+0.5*SH*TH/UH*
2867 & (W2HI-2.*W2SI)+0.125*(UH-12.*SQMQ-4.*SH*TH/UH)*W3SUTI)
2868 B2UTSR=SQMQ/SQMH**2*(UH*(SH-UH)/(UH+SH)+2.*TH*SH*(SH+2.*UH)/
2869 & (UH+SH)**2*(W1TR-W1HR)+(SQMQ-UH/4.)*(0.5*W2UR+0.5*W2HR-W2TR+
2870 & W3UTSR)+UH2*(2.*SQMQ/(UH+SH)**2-0.5/(UH+SH))*(W2TR-W2HR)+
2871 & 0.5*TH*SH/UH*(W2HR-2.*W2TR)+0.125*(UH-12.*SQMQ-4.*TH*SH/UH)*
2872 & W3TUSR)
2873 B2UTSI=SQMQ/SQMH**2*(2.*TH*SH*(SH+2.*UH)/(UH+SH)**2*
2874 & (W1TI-W1HI)+(SQMQ-UH/4.)*(0.5*W2UI+0.5*W2HI-W2TI+W3UTSI)+
2875 & UH2*(2.*SQMQ/(UH+SH)**2-0.5/(UH+SH))*(W2TI-W2HI)+0.5*TH*SH/UH*
2876 & (W2HI-2.*W2TI)+0.125*(UH-12.*SQMQ-4.*TH*SH/UH)*W3TUSI)
2877 B4STUR=0.25*EPSH*(-2./3.+0.25*(EPSH-1.)*(W2SR-W2HR+W3STUR))
2878 B4STUI=0.25*EPSH*0.25*(EPSH-1.)*(W2SI-W2HI+W3STUI)
2879 B4TUSR=0.25*EPSH*(-2./3.+0.25*(EPSH-1.)*(W2TR-W2HR+W3TUSR))
2880 B4TUSI=0.25*EPSH*0.25*(EPSH-1.)*(W2TI-W2HI+W3TUSI)
2881 B4USTR=0.25*EPSH*(-2./3.+0.25*(EPSH-1.)*(W2UR-W2HR+W3USTR))
2882 B4USTI=0.25*EPSH*0.25*(EPSH-1.)*(W2UI-W2HI+W3USTI)
2883 A2STUR=A2STUR+B2STUR+B2SUTR
2884 A2STUI=A2STUI+B2STUI+B2SUTI
2885 A2USTR=A2USTR+B2USTR+B2UTSR
2886 A2USTI=A2USTI+B2USTI+B2UTSI
2887 A2TUSR=A2TUSR+B2TUSR+B2TSUR
2888 A2TUSI=A2TUSI+B2TUSI+B2TSUI
2889 A4STUR=A4STUR+B4STUR+B4USTR+B4TUSR
2890 A4STUI=A4STUI+B4STUI+B4USTI+B4TUSI
2891 1150 CONTINUE
2892 FACGH=COMFAC*FACA*3./(128.*PARU(1)**2)*AEM/XW*AS**3*
2893 & SQMH/SQMW*SQMH**3/(SH*TH*UH)*(A2STUR**2+A2STUI**2+A2USTR**2+
2894 & A2USTI**2+A2TUSR**2+A2TUSI**2+A4STUR**2+A4STUI**2)
2895 FACGH=FACGH*WIDS(25,2)
2896 IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 1160
2897 NCHN=NCHN+1
2898 ISIG(NCHN,1)=21
2899 ISIG(NCHN,2)=21
2900 ISIG(NCHN,3)=1
2901 SIGH(NCHN)=FACGH
2902 1160 CONTINUE
2903
2904 ELSEIF(ISUB.EQ.114.OR.ISUB.EQ.115) THEN
2905C...g + g -> gamma + gamma or g + g -> g + gamma.
2906 A0STUR=0.
2907 A0STUI=0.
2908 A0TSUR=0.
2909 A0TSUI=0.
2910 A0UTSR=0.
2911 A0UTSI=0.
2912 A1STUR=0.
2913 A1STUI=0.
2914 A2STUR=0.
2915 A2STUI=0.
2916 ALST=LOG(-SH/TH)
2917 ALSU=LOG(-SH/UH)
2918 ALTU=LOG(TH/UH)
2919 IMAX=2*MSTP(1)
2920 IF(MSTP(38).GE.1.AND.MSTP(38).LE.8) IMAX=MSTP(38)
2921 DO 1170 I=1,IMAX
2922 EI=KCHG(IABS(I),1)/3.
2923 EIWT=EI**2
2924 IF(ISUB.EQ.115) EIWT=EI
2925 SQMQ=PMAS(I,1)**2
2926 EPSS=4.*SQMQ/SH
2927 EPST=4.*SQMQ/TH
2928 EPSU=4.*SQMQ/UH
2929 IF((MSTP(38).GE.1.AND.MSTP(38).LE.8).OR.EPSS.LT.1.E-4) THEN
2930 B0STUR=1.+(TH-UH)/SH*ALTU+0.5*(TH2+UH2)/SH2*(ALTU**2+
2931 & PARU(1)**2)
2932 B0STUI=0.
2933 B0TSUR=1.+(SH-UH)/TH*ALSU+0.5*(SH2+UH2)/TH2*ALSU**2
2934 B0TSUI=-PARU(1)*((SH-UH)/TH+(SH2+UH2)/TH2*ALSU)
2935 B0UTSR=1.+(SH-TH)/UH*ALST+0.5*(SH2+TH2)/UH2*ALST**2
2936 B0UTSI=-PARU(1)*((SH-TH)/UH+(SH2+TH2)/UH2*ALST)
2937 B1STUR=-1.
2938 B1STUI=0.
2939 B2STUR=-1.
2940 B2STUI=0.
2941 ELSE
2942 CALL PYWAUX(1,EPSS,W1SR,W1SI)
2943 CALL PYWAUX(1,EPST,W1TR,W1TI)
2944 CALL PYWAUX(1,EPSU,W1UR,W1UI)
2945 CALL PYWAUX(2,EPSS,W2SR,W2SI)
2946 CALL PYWAUX(2,EPST,W2TR,W2TI)
2947 CALL PYWAUX(2,EPSU,W2UR,W2UI)
2948 CALL PYI3AU(EPSS,TH/UH,Y3STUR,Y3STUI)
2949 CALL PYI3AU(EPSS,UH/TH,Y3SUTR,Y3SUTI)
2950 CALL PYI3AU(EPST,SH/UH,Y3TSUR,Y3TSUI)
2951 CALL PYI3AU(EPST,UH/SH,Y3TUSR,Y3TUSI)
2952 CALL PYI3AU(EPSU,SH/TH,Y3USTR,Y3USTI)
2953 CALL PYI3AU(EPSU,TH/SH,Y3UTSR,Y3UTSI)
2954 B0STUR=1.+(1.+2.*TH/SH)*W1TR+(1.+2.*UH/SH)*W1UR+
2955 & 0.5*((TH2+UH2)/SH2-EPSS)*(W2TR+W2UR)-
2956 & 0.25*EPST*(1.-0.5*EPSS)*(Y3SUTR+Y3TUSR)-
2957 & 0.25*EPSU*(1.-0.5*EPSS)*(Y3STUR+Y3UTSR)+
2958 & 0.25*(-2.*(TH2+UH2)/SH2+4.*EPSS+EPST+EPSU+0.5*EPST*EPSU)*
2959 & (Y3TSUR+Y3USTR)
2960 B0STUI=(1.+2.*TH/SH)*W1TI+(1.+2.*UH/SH)*W1UI+
2961 & 0.5*((TH2+UH2)/SH2-EPSS)*(W2TI+W2UI)-
2962 & 0.25*EPST*(1.-0.5*EPSS)*(Y3SUTI+Y3TUSI)-
2963 & 0.25*EPSU*(1.-0.5*EPSS)*(Y3STUI+Y3UTSI)+
2964 & 0.25*(-2.*(TH2+UH2)/SH2+4.*EPSS+EPST+EPSU+0.5*EPST*EPSU)*
2965 & (Y3TSUI+Y3USTI)
2966 B0TSUR=1.+(1.+2.*SH/TH)*W1SR+(1.+2.*UH/TH)*W1UR+
2967 & 0.5*((SH2+UH2)/TH2-EPST)*(W2SR+W2UR)-
2968 & 0.25*EPSS*(1.-0.5*EPST)*(Y3TUSR+Y3SUTR)-
2969 & 0.25*EPSU*(1.-0.5*EPST)*(Y3TSUR+Y3USTR)+
2970 & 0.25*(-2.*(SH2+UH2)/TH2+4.*EPST+EPSS+EPSU+0.5*EPSS*EPSU)*
2971 & (Y3STUR+Y3UTSR)
2972 B0TSUI=(1.+2.*SH/TH)*W1SI+(1.+2.*UH/TH)*W1UI+
2973 & 0.5*((SH2+UH2)/TH2-EPST)*(W2SI+W2UI)-
2974 & 0.25*EPSS*(1.-0.5*EPST)*(Y3TUSI+Y3SUTI)-
2975 & 0.25*EPSU*(1.-0.5*EPST)*(Y3TSUI+Y3USTI)+
2976 & 0.25*(-2.*(SH2+UH2)/TH2+4.*EPST+EPSS+EPSU+0.5*EPSS*EPSU)*
2977 & (Y3STUI+Y3UTSI)
2978 B0UTSR=1.+(1.+2.*TH/UH)*W1TR+(1.+2.*SH/UH)*W1SR+
2979 & 0.5*((TH2+SH2)/UH2-EPSU)*(W2TR+W2SR)-
2980 & 0.25*EPST*(1.-0.5*EPSU)*(Y3USTR+Y3TSUR)-
2981 & 0.25*EPSS*(1.-0.5*EPSU)*(Y3UTSR+Y3STUR)+
2982 & 0.25*(-2.*(TH2+SH2)/UH2+4.*EPSU+EPST+EPSS+0.5*EPST*EPSS)*
2983 & (Y3TUSR+Y3SUTR)
2984 B0UTSI=(1.+2.*TH/UH)*W1TI+(1.+2.*SH/UH)*W1SI+
2985 & 0.5*((TH2+SH2)/UH2-EPSU)*(W2TI+W2SI)-
2986 & 0.25*EPST*(1.-0.5*EPSU)*(Y3USTI+Y3TSUI)-
2987 & 0.25*EPSS*(1.-0.5*EPSU)*(Y3UTSI+Y3STUI)+
2988 & 0.25*(-2.*(TH2+SH2)/UH2+4.*EPSU+EPST+EPSS+0.5*EPST*EPSS)*
2989 & (Y3TUSI+Y3SUTI)
2990 B1STUR=-1.-0.25*(EPSS+EPST+EPSU)*(W2SR+W2TR+W2UR)+
2991 & 0.25*(EPSU+0.5*EPSS*EPST)*(Y3SUTR+Y3TUSR)+
2992 & 0.25*(EPST+0.5*EPSS*EPSU)*(Y3STUR+Y3UTSR)+
2993 & 0.25*(EPSS+0.5*EPST*EPSU)*(Y3TSUR+Y3USTR)
2994 B1STUI=-0.25*(EPSS+EPST+EPSU)*(W2SI+W2TI+W2UI)+
2995 & 0.25*(EPSU+0.5*EPSS*EPST)*(Y3SUTI+Y3TUSI)+
2996 & 0.25*(EPST+0.5*EPSS*EPSU)*(Y3STUI+Y3UTSI)+
2997 & 0.25*(EPSS+0.5*EPST*EPSU)*(Y3TSUI+Y3USTI)
2998 B2STUR=-1.+0.125*EPSS*EPST*(Y3SUTR+Y3TUSR)+
2999 & 0.125*EPSS*EPSU*(Y3STUR+Y3UTSR)+
3000 & 0.125*EPST*EPSU*(Y3TSUR+Y3USTR)
3001 B2STUI=0.125*EPSS*EPST*(Y3SUTI+Y3TUSI)+
3002 & 0.125*EPSS*EPSU*(Y3STUI+Y3UTSI)+
3003 & 0.125*EPST*EPSU*(Y3TSUI+Y3USTI)
3004 ENDIF
3005 A0STUR=A0STUR+EIWT*B0STUR
3006 A0STUI=A0STUI+EIWT*B0STUI
3007 A0TSUR=A0TSUR+EIWT*B0TSUR
3008 A0TSUI=A0TSUI+EIWT*B0TSUI
3009 A0UTSR=A0UTSR+EIWT*B0UTSR
3010 A0UTSI=A0UTSI+EIWT*B0UTSI
3011 A1STUR=A1STUR+EIWT*B1STUR
3012 A1STUI=A1STUI+EIWT*B1STUI
3013 A2STUR=A2STUR+EIWT*B2STUR
3014 A2STUI=A2STUI+EIWT*B2STUI
3015 1170 CONTINUE
3016 ASQSUM=A0STUR**2+A0STUI**2+A0TSUR**2+A0TSUI**2+A0UTSR**2+
3017 & A0UTSI**2+4.*A1STUR**2+4.*A1STUI**2+A2STUR**2+A2STUI**2
3018 FACGG=COMFAC*FACA/(16.*PARU(1)**2)*AS**2*AEM**2*ASQSUM
3019 FACGP=COMFAC*FACA*5./(192.*PARU(1)**2)*AS**3*AEM*ASQSUM
3020 IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 1180
3021 NCHN=NCHN+1
3022 ISIG(NCHN,1)=21
3023 ISIG(NCHN,2)=21
3024 ISIG(NCHN,3)=1
3025 IF(ISUB.EQ.114) SIGH(NCHN)=0.5*FACGG
3026 IF(ISUB.EQ.115) SIGH(NCHN)=FACGP
3027 1180 CONTINUE
3028
3029 ELSEIF(ISUB.EQ.116) THEN
3030C...g + g -> gamma + Z0.
3031
3032 ELSEIF(ISUB.EQ.117) THEN
3033C...g + g -> Z0 + Z0.
3034
3035 ELSEIF(ISUB.EQ.118) THEN
3036C...g + g -> W+ + W-.
3037
3038 ENDIF
3039
3040C...G: 2 -> 3, tree diagrams.
3041
3042 ELSEIF(ISUB.LE.140) THEN
3043 IF(ISUB.EQ.121) THEN
3044C...g + g -> Q + Q~ + H0.
3045 IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 1190
3046 IA=KFPR(ISUBSV,2)
3047 PMF=PMAS(IA,1)
3048 FACQQH=COMFAC*(4.*PARU(1)*AEM/XW)*(4.*PARU(1)*AS)**2*
3049 & (0.5*PMF/PMAS(24,1))**2
3050 IF(IA.LE.10.AND.MSTP(37).EQ.1.AND.MSTP(2).GE.1) FACQQH=
3051 & FACQQH*(LOG(MAX(4.,PARP(37)**2*PMF**2/PARU(117)**2))/
3052 & LOG(MAX(4.,SH/PARU(117)**2)))**(24./(33.-2.*MSTU(118)))
3053 WID2=1.
3054 IF(IA.EQ.6.AND.MSTP(48).GE.1) WID2=WIDS(26,1)
3055 IF((IA.EQ.7.OR.IA.EQ.8).AND.MSTP(49).GE.1) WID2=WIDS(IA+20,1)
3056 FACQQH=FACQQH*WID2
3057 IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN
3058 IKFI=1
3059 IF(IA.LE.10.AND.MOD(IA,2).EQ.0) IKFI=2
3060 IF(IA.GT.10) IKFI=3
3061 FACQQH=FACQQH*PARU(150+10*IHIGG+IKFI)**2
3062 ENDIF
3063 CALL PYQQBH(WTQQBH)
3064 CALL PYWIDT(KFHIGG,SH,WDTP,WDTE)
3065 HP=AEM/(8.*XW)*SH/SQMW*SH
3066 HS=HP*WDTP(0)
3067 HF=HP*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
3068 FACBW=(1./PARU(1))*VINT(2)*HF/((SH-SQMH)**2+HS**2)
3069 IF(ABS(SH-SQMH).GT.100.*HS) FACBW=0.
3070 NCHN=NCHN+1
3071 ISIG(NCHN,1)=21
3072 ISIG(NCHN,2)=21
3073 ISIG(NCHN,3)=1
3074 SIGH(NCHN)=FACQQH*WTQQBH*FACBW
3075 1190 CONTINUE
3076
3077 ELSEIF(ISUB.EQ.122) THEN
3078C...q + q~ -> Q + Q~ + H0.
3079 IA=KFPR(ISUBSV,2)
3080 PMF=PMAS(IA,1)
3081 FACQQH=COMFAC*(4.*PARU(1)*AEM/XW)*(4.*PARU(1)*AS)**2*
3082 & (0.5*PMF/PMAS(24,1))**2
3083 IF(IA.LE.10.AND.MSTP(37).EQ.1.AND.MSTP(2).GE.1) FACQQH=
3084 & FACQQH*(LOG(MAX(4.,PARP(37)**2*PMF**2/PARU(117)**2))/
3085 & LOG(MAX(4.,SH/PARU(117)**2)))**(24./(33.-2.*MSTU(118)))
3086 WID2=1.
3087 IF(IA.EQ.6.AND.MSTP(48).GE.1) WID2=WIDS(26,1)
3088 IF((IA.EQ.7.OR.IA.EQ.8).AND.MSTP(49).GE.1) WID2=WIDS(IA+20,1)
3089 FACQQH=FACQQH*WID2
3090 IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN
3091 IKFI=1
3092 IF(IA.LE.10.AND.MOD(IA,2).EQ.0) IKFI=2
3093 IF(IA.GT.10) IKFI=3
3094 FACQQH=FACQQH*PARU(150+10*IHIGG+IKFI)**2
3095 ENDIF
3096 CALL PYQQBH(WTQQBH)
3097 CALL PYWIDT(KFHIGG,SH,WDTP,WDTE)
3098 HP=AEM/(8.*XW)*SH/SQMW*SH
3099 HS=HP*WDTP(0)
3100 HF=HP*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
3101 FACBW=(1./PARU(1))*VINT(2)*HF/((SH-SQMH)**2+HS**2)
3102 IF(ABS(SH-SQMH).GT.100.*HS) FACBW=0.
3103 DO 1200 I=MMINA,MMAXA
3104 IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
3105 & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1200
3106 NCHN=NCHN+1
3107 ISIG(NCHN,1)=I
3108 ISIG(NCHN,2)=-I
3109 ISIG(NCHN,3)=1
3110 SIGH(NCHN)=FACQQH*WTQQBH*FACBW
3111 1200 CONTINUE
3112
3113 ELSEIF(ISUB.EQ.123) THEN
3114C...f + f' -> f + f' + H0 (or H'0, or A0) (Z0 + Z0 -> H0 as
3115C...inner process).
3116 FACNOR=COMFAC*(4.*PARU(1)*AEM/(XW*XW1))**3*SQMZ/32.
3117 IF(MSTP(4).GE.1.OR.IHIGG.GE.2) FACNOR=FACNOR*
3118 & PARU(154+10*IHIGG)**2
3119 FACPRP=1./((VINT(215)-VINT(204)**2)*(VINT(216)-VINT(209)**2))**2
3120 FACZZ1=FACNOR*FACPRP*(0.5*TAUP*VINT(2))*VINT(219)
3121 FACZZ2=FACNOR*FACPRP*VINT(217)*VINT(218)
3122 CALL PYWIDT(KFHIGG,SH,WDTP,WDTE)
3123 HP=AEM/(8.*XW)*SH/SQMW*SH
3124 HS=HP*WDTP(0)
3125 HF=HP*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
3126 FACBW=(1./PARU(1))*VINT(2)*HF/((SH-SQMH)**2+HS**2)
3127 IF(ABS(SH-SQMH).GT.100.*HS) FACBW=0.
3128 DO 1220 I=MMIN1,MMAX1
3129 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 1220
3130 IA=IABS(I)
3131 DO 1210 J=MMIN2,MMAX2
3132 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 1210
3133 JA=IABS(J)
3134 EI=KCHG(IA,1)*ISIGN(1,I)/3.
3135 AI=SIGN(1.,KCHG(IA,1)+0.5)*ISIGN(1,I)
3136 VI=AI-4.*EI*XWV
3137 EJ=KCHG(JA,1)*ISIGN(1,J)/3.
3138 AJ=SIGN(1.,KCHG(JA,1)+0.5)*ISIGN(1,J)
3139 VJ=AJ-4.*EJ*XWV
3140 FACLR1=(VI**2+AI**2)*(VJ**2+AJ**2)+4.*VI*AI*VJ*AJ
3141 FACLR2=(VI**2+AI**2)*(VJ**2+AJ**2)-4.*VI*AI*VJ*AJ
3142 NCHN=NCHN+1
3143 ISIG(NCHN,1)=I
3144 ISIG(NCHN,2)=J
3145 ISIG(NCHN,3)=1
3146 SIGH(NCHN)=(FACLR1*FACZZ1+FACLR2*FACZZ2)*FACBW
3147 1210 CONTINUE
3148 1220 CONTINUE
3149
3150 ELSEIF(ISUB.EQ.124) THEN
3151C...f + f' -> f" + f"' + H0 (or H'0, or A0) (W+ + W- -> H0 as
3152C...inner process).
3153 FACNOR=COMFAC*(4.*PARU(1)*AEM/XW)**3*SQMW
3154 IF(MSTP(4).GE.1.OR.IHIGG.GE.2) FACNOR=FACNOR*
3155 & PARU(155+10*IHIGG)**2
3156 FACPRP=1./((VINT(215)-VINT(204)**2)*(VINT(216)-VINT(209)**2))**2
3157 FACWW=FACNOR*FACPRP*(0.5*TAUP*VINT(2))*VINT(219)
3158 CALL PYWIDT(KFHIGG,SH,WDTP,WDTE)
3159 HP=AEM/(8.*XW)*SH/SQMW*SH
3160 HS=HP*WDTP(0)
3161 HF=HP*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
3162 FACBW=(1./PARU(1))*VINT(2)*HF/((SH-SQMH)**2+HS**2)
3163 IF(ABS(SH-SQMH).GT.100.*HS) FACBW=0.
3164 DO 1240 I=MMIN1,MMAX1
3165 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 1240
3166 EI=SIGN(1.,FLOAT(I))*KCHG(IABS(I),1)
3167 DO 1230 J=MMIN2,MMAX2
3168 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 1230
3169 EJ=SIGN(1.,FLOAT(J))*KCHG(IABS(J),1)
3170 IF(EI*EJ.GT.0.) GOTO 1230
3171 FACLR=VINT(180+I)*VINT(180+J)
3172 NCHN=NCHN+1
3173 ISIG(NCHN,1)=I
3174 ISIG(NCHN,2)=J
3175 ISIG(NCHN,3)=1
3176 SIGH(NCHN)=FACLR*FACWW*FACBW
3177 1230 CONTINUE
3178 1240 CONTINUE
3179
3180 ELSEIF(ISUB.EQ.131) THEN
3181C...g + g -> Z0 + q + qbar.
3182 IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 1280
3183
3184C...Read out information on flavours, masses, couplings.
3185 KFQ=KFPR(131,2)
3186 KFL=IABS(KFDP(MINT(35),1))
3187 PMH=SQRT(SH)
3188 PMQQ=SQRT(VINT(64))
3189 PMLL=SQRT(VINT(63))
3190 PMQ=PMAS(KFQ,1)
3191 QFQ=KCHG(KFQ,1)/3.
3192 AFQ=SIGN(1.,QFQ+0.1)
3193 VFQ=AFQ-4.*XWV*QFQ
3194 QFL=KCHG(KFL,1)/3.
3195 AFL=SIGN(1.,QFL+0.1)
3196 VFL=AFL-4.*XWV*QFL
3197 WID2=1.
3198 IF(KFQ.EQ.6.AND.MSTP(48).GE.1) WID2=WIDS(26,1)
3199 IF((KFQ.EQ.7.OR.KFQ.EQ.8).AND.MSTP(49).GE.1) WID2=WIDS(KFQ+20,1)
3200
3201C...Set line numbers for particles.
3202 IG1=MINT(84)+1
3203 IG2=MINT(84)+2
3204 IQ1=MINT(84)+3
3205 IQ2=MINT(84)+4
3206 IL1=MINT(84)+5
3207 IL2=MINT(84)+6
3208 IZ=MINT(84)+7
3209
3210C...Reconstruct decay kinematics.
3211 DO 1260 I=MINT(84)+1,MINT(84)+7
3212 K(I,1)=1
3213 DO 1250 J=1,5
3214 P(I,J)=0.
3215 1250 CONTINUE
3216 1260 CONTINUE
3217 P(IG1,4)=0.5*PMH
3218 P(IG1,3)=P(IG1,4)
3219 P(IG2,4)=P(IG1,4)
3220 P(IG2,3)=-P(IG1,3)
3221 P(IQ1,5)=PMQ
3222 P(IQ1,4)=0.5*PMQQ
3223 P(IQ1,3)=SQRT(MAX(0.,P(IQ1,4)**2-PMQ**2))
3224 P(IQ2,5)=PMQ
3225 P(IQ2,4)=P(IQ1,4)
3226 P(IQ2,3)=-P(IQ1,3)
3227 P(IL1,4)=0.5*PMLL
3228 P(IL1,3)=P(IL1,4)
3229 P(IL2,4)=P(IL1,4)
3230 P(IL2,3)=-P(IL1,3)
3231 P(IZ,5)=PMLL
3232 P(IZ,4)=0.5*(PMH+(PMLL**2-PMQQ**2)/PMH)
3233 P(IZ,3)=SQRT(MAX(0.,P(IZ,4)**2-PMLL**2))
3234 CALL LUDBRB(IQ1,IQ2,ACOS(VINT(83)),VINT(84),0D0,0D0,
3235 & -DBLE(P(IZ,3)/(PMH-P(IZ,4))))
3236 CALL LUDBRB(IL1,IL2,ACOS(VINT(81)),VINT(82),0D0,0D0,
3237 & DBLE(P(IZ,3)/P(IZ,4)))
3238 CALL LUDBRB(IQ1,IZ,ACOS(VINT(23)),VINT(24),0D0,0D0,0D0)
3239
3240C...Interface information to program of Ronald Kleiss.
3241 RKMQ=PMQ
3242 RKMZ=PMAS(23,1)
3243 RKGZ=PMAS(23,2)
3244 RKVQ=VFQ
3245 RKAQ=AFQ
3246 RKVL=VFL
3247 RKAL=AFL
3248 RKG1(0)=P(IG1,4)
3249 RKG2(0)=P(IG2,4)
3250 RKQ1(0)=P(IQ1,4)
3251 RKQ2(0)=P(IQ2,4)
3252 RKL1(0)=P(IL1,4)
3253 RKL2(0)=P(IL2,4)
3254 DO 1270 J=1,3
3255 RKG1(J)=P(IG1,J)
3256 RKG2(J)=P(IG2,J)
3257 RKQ1(J)=P(IQ1,J)
3258 RKQ2(J)=P(IQ2,J)
3259 RKL1(J)=P(IL1,J)
3260 RKL2(J)=P(IL2,J)
3261 1270 CONTINUE
3262 CALL RKBBV(RKG1,RKG2,RKQ1,RKQ2,RKL1,RKL2,1,RKRES)
3263
3264C...Multiply with normalization factors.
3265 WTMEP=1./(2.*SH*PARU(2)**8)
3266 WTCOU=AS**2*(4.*PARU(1)*AEM*XWC)**2
3267 WTZQQ=WTMEP*WTCOU*RKRES
3268 WTPHS=(PARU(1)/2.)**2*PMQQ**2*
3269 & (PARU(1)*((PMLL**2-PMAS(23,1)**2)**2+(PMAS(23,1)*
3270 & PMAS(23,2))**2)/(PMAS(23,1)*PMAS(23,2)))*0.5*SH
3271 NCHN=NCHN+1
3272 ISIG(NCHN,1)=21
3273 ISIG(NCHN,2)=21
3274 ISIG(NCHN,3)=INT(1.5+RLU(0))
3275 SIGH(NCHN)=COMFAC*WTPHS*WTZQQ*WID2
3276 1280 CONTINUE
3277 ENDIF
3278
3279C...H: 2 -> 1, tree diagrams, non-standard model processes.
3280
3281 ELSEIF(ISUB.LE.160) THEN
3282 IF(ISUB.EQ.141) THEN
3283C...f + f~ -> gamma*/Z0/Z'0.
3284 MINT(61)=2
3285 CALL PYWIDT(32,SH,WDTP,WDTE)
3286 HP0=AEM/3.*SH
3287 HP1=AEM/3.*XWC*SH
3288 HP2=HP1
3289 HS=HP1*VINT(117)
3290 HSP=HP2*WDTP(0)
3291 FACZP=4.*COMFAC*3.
3292 DO 1290 I=MMINA,MMAXA
3293 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1290
3294 EI=KCHG(IABS(I),1)/3.
3295 AI=SIGN(1.,EI)
3296 VI=AI-4.*EI*XWV
3297 IF(IABS(I).LT.10) THEN
3298 VPI=PARU(123-2*MOD(IABS(I),2))
3299 API=PARU(124-2*MOD(IABS(I),2))
3300 ELSE
3301 VPI=PARU(127-2*MOD(IABS(I),2))
3302 API=PARU(128-2*MOD(IABS(I),2))
3303 ENDIF
3304 HI0=HP0
3305 IF(IABS(I).LE.10) HI0=HI0*FACA/3.
3306 HI1=HP1
3307 IF(IABS(I).LE.10) HI1=HI1*FACA/3.
3308 HI2=HP2
3309 IF(IABS(I).LE.10) HI2=HI2*FACA/3.
3310 NCHN=NCHN+1
3311 ISIG(NCHN,1)=I
3312 ISIG(NCHN,2)=-I
3313 ISIG(NCHN,3)=1
3314 SIGH(NCHN)=FACZP*(EI**2/SH2*HI0*HP0*VINT(111)+EI*VI*
3315 & (1.-SQMZ/SH)/((SH-SQMZ)**2+HS**2)*(HI0*HP1+HI1*HP0)*VINT(112)+
3316 & EI*VPI*(1.-SQMZP/SH)/((SH-SQMZP)**2+HSP**2)*(HI0*HP2+HI2*HP0)*
3317 & VINT(113)+(VI**2+AI**2)/((SH-SQMZ)**2+HS**2)*HI1*HP1*VINT(114)+
3318 & (VI*VPI+AI*API)*((SH-SQMZ)*(SH-SQMZP)+HS*HSP)/(((SH-SQMZ)**2+
3319 & HS**2)*((SH-SQMZP)**2+HSP**2))*(HI1*HP2+HI2*HP1)*VINT(115)+
3320 & (VPI**2+API**2)/((SH-SQMZP)**2+HSP**2)*HI2*HP2*VINT(116))
3321 1290 CONTINUE
3322
3323 ELSEIF(ISUB.EQ.142) THEN
3324C...f + f~' -> W'+/-.
3325 CALL PYWIDT(34,SH,WDTP,WDTE)
3326 HP=AEM/(24.*XW)*SH
3327 HS=HP*WDTP(0)
3328 FACBW=4.*COMFAC/((SH-SQMWP)**2+HS**2)*3.
3329 DO 1310 I=MMIN1,MMAX1
3330 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 1310
3331 IA=IABS(I)
3332 DO 1300 J=MMIN2,MMAX2
3333 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 1300
3334 JA=IABS(J)
3335 IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 1300
3336 IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) GOTO 1300
3337 KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
3338 HI=HP*(PARU(133)**2+PARU(134)**2)
3339 IF(IA.LE.10) HI=HP*(PARU(131)**2+PARU(132)**2)*
3340 & VCKM((IA+1)/2,(JA+1)/2)*FACA/3.
3341 NCHN=NCHN+1
3342 ISIG(NCHN,1)=I
3343 ISIG(NCHN,2)=J
3344 ISIG(NCHN,3)=1
3345 HF=HP*(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))
3346 SIGH(NCHN)=HI*FACBW*HF
3347 1300 CONTINUE
3348 1310 CONTINUE
3349
3350 ELSEIF(ISUB.EQ.143) THEN
3351C...f + f~' -> H+/-.
3352 CALL PYWIDT(37,SH,WDTP,WDTE)
3353 HP=AEM/(8.*XW)*SH/SQMW*SH
3354 HS=HP*WDTP(0)
3355 FACBW=4.*COMFAC/((SH-SQMHC)**2+HS**2)
3356 DO 1330 I=MMIN1,MMAX1
3357 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 1330
3358 IA=IABS(I)
3359 IM=(MOD(IA,10)+1)/2
3360 DO 1320 J=MMIN2,MMAX2
3361 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 1320
3362 JA=IABS(J)
3363 JM=(MOD(JA,10)+1)/2
3364 IF(I*J.GT.0.OR.IA.EQ.JA.OR.IM.NE.JM) GOTO 1320
3365 IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) GOTO 1320
3366 IF(MOD(IA,2).EQ.0) THEN
3367 IU=IA
3368 IL=JA
3369 ELSE
3370 IU=JA
3371 IL=IA
3372 ENDIF
3373 RML=PMAS(IL,1)**2/SH
3374 RMU=PMAS(IU,1)**2/SH
3375 IF(IL.LE.10.AND.MSTP(37).EQ.1.AND.MSTP(2).GE.1) RML=RML*
3376 & (LOG(MAX(4.,PARP(37)**2*RML*SH/PARU(117)**2))/
3377 & LOG(MAX(4.,SH/PARU(117)**2)))**(24./(33.-2.*MSTU(118)))
3378 HI=HP*(RML*PARU(141)**2+RMU/PARU(141)**2)
3379 IF(IA.LE.10) HI=HI*FACA/3.
3380 KCHHC=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
3381 HF=HP*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4))
3382 NCHN=NCHN+1
3383 ISIG(NCHN,1)=I
3384 ISIG(NCHN,2)=J
3385 ISIG(NCHN,3)=1
3386 SIGH(NCHN)=HI*FACBW*HF
3387 1320 CONTINUE
3388 1330 CONTINUE
3389
3390 ELSEIF(ISUB.EQ.144) THEN
3391C...f + f~' -> R.
3392 CALL PYWIDT(40,SH,WDTP,WDTE)
3393 HP=AEM/(12.*XW)*SH
3394 HS=HP*WDTP(0)
3395 FACBW=4.*COMFAC/((SH-SQMR)**2+HS**2)*3.
3396 DO 1350 I=MMIN1,MMAX1
3397 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 1350
3398 IA=IABS(I)
3399 DO 1340 J=MMIN2,MMAX2
3400 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 1340
3401 JA=IABS(J)
3402 IF(I*J.GT.0.OR.IABS(IA-JA).NE.2) GOTO 1340
3403 HI=HP
3404 IF(IA.LE.10) HI=HI*FACA/3.
3405 HF=HP*(WDTE(0,1)+WDTE(0,(10-(I+J))/4)+WDTE(0,4))
3406 NCHN=NCHN+1
3407 ISIG(NCHN,1)=I
3408 ISIG(NCHN,2)=J
3409 ISIG(NCHN,3)=1
3410 SIGH(NCHN)=HI*FACBW*HF
3411 1340 CONTINUE
3412 1350 CONTINUE
3413
3414 ELSEIF(ISUB.EQ.145) THEN
3415C...q + l -> LQ (leptoquark).
3416 CALL PYWIDT(39,SH,WDTP,WDTE)
3417 HP=AEM/4.*SH
3418 HS=HP*WDTP(0)
3419 FACBW=4.*COMFAC/((SH-SQMLQ)**2+HS**2)
3420 IF(ABS(SH-SQMLQ).GT.100.*HS) FACBW=0.
3421 KFLQQ=KFDP(MDCY(39,2),1)
3422 KFLQL=KFDP(MDCY(39,2),2)
3423 DO 1370 I=MMIN1,MMAX1
3424 IF(KFAC(1,I).EQ.0) GOTO 1370
3425 IA=IABS(I)
3426 IF(IA.NE.KFLQQ.AND.IA.NE.KFLQL) GOTO 1370
3427 DO 1360 J=MMIN2,MMAX2
3428 IF(KFAC(2,J).EQ.0) GOTO 1360
3429 JA=IABS(J)
3430 IF(JA.NE.KFLQQ.AND.JA.NE.KFLQL) GOTO 1360
3431 IF(I*J.NE.KFLQQ*KFLQL) GOTO 1360
3432 IF(IA.EQ.KFLQQ) KCHLQ=ISIGN(1,I)
3433 IF(JA.EQ.KFLQQ) KCHLQ=ISIGN(1,J)
3434 HI=HP*PARU(151)
3435 HF=HP*(WDTE(0,1)+WDTE(0,(5-KCHLQ)/2)+WDTE(0,4))
3436 NCHN=NCHN+1
3437 ISIG(NCHN,1)=I
3438 ISIG(NCHN,2)=J
3439 ISIG(NCHN,3)=1
3440 SIGH(NCHN)=HI*FACBW*HF
3441 1360 CONTINUE
3442 1370 CONTINUE
3443
3444 ELSEIF(ISUB.EQ.147.OR.ISUB.EQ.148) THEN
3445C...d + g -> d* and u + g -> u* (excited quarks).
3446 KFQEXC=ISUB-146
3447 KFQSTR=ISUB-140
3448 CALL PYWIDT(KFQSTR,SH,WDTP,WDTE)
3449 HP=SH
3450 HS=HP*WDTP(0)
3451 FACBW=COMFAC/((SH-PMAS(KFQSTR,1)**2)**2+HS**2)
3452 FACBW=FACBW*AS*PARU(159)**2*SH/(3.*PARU(155)**2)
3453 IF(ABS(SH-PMAS(KFQSTR,1)**2).GT.100.*HS) FACBW=0.
3454 DO 1390 I=-KFQEXC,KFQEXC,2*KFQEXC
3455 DO 1380 ISDE=1,2
3456 IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 1380
3457 IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 1380
3458 HI=HP
3459 IF(I.GT.0) HF=HP*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
3460 IF(I.LT.0) HF=HP*(WDTE(0,1)+WDTE(0,3)+WDTE(0,4))
3461 NCHN=NCHN+1
3462 ISIG(NCHN,ISDE)=I
3463 ISIG(NCHN,3-ISDE)=21
3464 ISIG(NCHN,3)=1
3465 SIGH(NCHN)=HI*FACBW*HF
3466 1380 CONTINUE
3467 1390 CONTINUE
3468
3469 ELSEIF(ISUB.EQ.149) THEN
3470C...g + g -> eta_techni.
3471 CALL PYWIDT(38,SH,WDTP,WDTE)
3472 HP=SH
3473 HS=HP*WDTP(0)
3474 FACBW=COMFAC*0.5/((SH-PMAS(38,1)**2)**2+HS**2)
3475 IF(ABS(SH-PMAS(38,1)**2).GT.100.*HS) FACBW=0.
3476 IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 1400
3477 HI=HP*WDTP(3)
3478 HF=HP*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
3479 NCHN=NCHN+1
3480 ISIG(NCHN,1)=21
3481 ISIG(NCHN,2)=21
3482 ISIG(NCHN,3)=1
3483 SIGH(NCHN)=HI*FACBW*HF
3484 1400 CONTINUE
3485
3486 ENDIF
3487
3488C...I: 2 -> 2, tree diagrams, non-standard model processes.
3489
3490 ELSE
3491 IF(ISUB.EQ.161) THEN
3492C...f + g -> f' + H+/- (b + g -> t + H+/- only)
3493C...(choice of only b and t to avoid kinematics problems).
3494 FHCQ=COMFAC*FACA*AS*AEM/XW*1./24
3495 DO 1420 I=MMINA,MMAXA
3496 IA=IABS(I)
3497 IF(IA.NE.5) GOTO 1420
3498 SQML=PMAS(IA,1)**2
3499 IF(IA.LE.10.AND.MSTP(37).EQ.1.AND.MSTP(2).GE.1) SQML=SQML*
3500 & (LOG(MAX(4.,PARP(37)**2*SQML/PARU(117)**2))/
3501 & LOG(MAX(4.,SH/PARU(117)**2)))**(24./(33.-2.*MSTU(118)))
3502 IUA=IA+MOD(IA,2)
3503 SQMQ=PMAS(IUA,1)**2
3504 FACHCQ=FHCQ*(SQML*PARU(141)**2+SQMQ/PARU(141)**2)/SQMW*
3505 & (SH/(SQMQ-UH)+2.*SQMQ*(SQMHC-UH)/(SQMQ-UH)**2+(SQMQ-UH)/SH+
3506 & 2.*SQMQ/(SQMQ-UH)+2.*(SQMHC-UH)/(SQMQ-UH)*(SQMHC-SQMQ-SH)/SH)
3507 KCHHC=ISIGN(1,KCHG(IA,1)*ISIGN(1,I))
3508 DO 1410 ISDE=1,2
3509 IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 1410
3510 IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,1).EQ.0) GOTO 1410
3511 NCHN=NCHN+1
3512 ISIG(NCHN,ISDE)=I
3513 ISIG(NCHN,3-ISDE)=21
3514 ISIG(NCHN,3)=1
3515 SIGH(NCHN)=FACHCQ*WIDS(37,(5-KCHHC)/2)
3516 1410 CONTINUE
3517 1420 CONTINUE
3518
3519 ELSEIF(ISUB.EQ.162) THEN
3520C...q + g -> LQ + l~; LQ=leptoquark.
3521 FACLQ=COMFAC*FACA*PARU(151)*(AS*AEM/6.)*(-TH/SH)*
3522 & (UH2+SQMLQ**2)/(UH-SQMLQ)**2
3523 KFLQQ=KFDP(MDCY(39,2),1)
3524 DO 1440 I=MMINA,MMAXA
3525 IF(IABS(I).NE.KFLQQ) GOTO 1440
3526 KCHLQ=ISIGN(1,I)
3527 DO 1430 ISDE=1,2
3528 IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 1430
3529 IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 1430
3530 NCHN=NCHN+1
3531 ISIG(NCHN,ISDE)=I
3532 ISIG(NCHN,3-ISDE)=21
3533 ISIG(NCHN,3)=1
3534 SIGH(NCHN)=FACLQ*WIDS(39,(5-KCHLQ)/2)
3535 1430 CONTINUE
3536 1440 CONTINUE
3537
3538 ELSEIF(ISUB.EQ.163) THEN
3539C...g + g -> LQ + LQ~; LQ=leptoquark.
3540 FACLQ=COMFAC*FACA*WIDS(39,1)*(AS**2/2.)*
3541 & (7./48.+3.*(UH-TH)**2/(16.*SH2))*(1.+2.*SQMLQ*TH/(TH-SQMLQ)**2+
3542 & 2.*SQMLQ*UH/(UH-SQMLQ)**2+4.*SQMLQ**2/((TH-SQMLQ)*(UH-SQMLQ)))
3543 IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 1450
3544 NCHN=NCHN+1
3545 ISIG(NCHN,1)=21
3546 ISIG(NCHN,2)=21
3547C...Since don't know proper colour flow, randomize between alternatives.
3548 ISIG(NCHN,3)=INT(1.5+RLU(0))
3549 SIGH(NCHN)=FACLQ
3550 1450 CONTINUE
3551
3552 ELSEIF(ISUB.EQ.164) THEN
3553C...q + q~ -> LQ + LQ~; LQ=leptoquark.
3554 FACLQA=COMFAC*WIDS(39,1)*(AS**2/9.)*
3555 & (SH*(SH-4.*SQMLQ)-(UH-TH)**2)/SH2
3556 FACLQS=COMFAC*WIDS(39,1)*((PARU(151)**2*AEM**2/8.)*
3557 & (-SH*TH-(SQMLQ-TH)**2)/TH2+(PARU(151)*AEM*AS/18.)*
3558 & ((SQMLQ-TH)*(UH-TH)+SH*(SQMLQ+TH))/(SH*TH))
3559 KFLQQ=KFDP(MDCY(39,2),1)
3560 DO 1460 I=MMINA,MMAXA
3561 IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
3562 & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1460
3563 NCHN=NCHN+1
3564 ISIG(NCHN,1)=I
3565 ISIG(NCHN,2)=-I
3566 ISIG(NCHN,3)=1
3567 SIGH(NCHN)=FACLQA
3568 IF(IABS(I).EQ.KFLQQ) SIGH(NCHN)=FACLQA+FACLQS
3569 1460 CONTINUE
3570
3571 ELSEIF(ISUB.EQ.165) THEN
3572C...q + q~ -> l+ + l- (including contact term for compositeness).
3573 ZRATR=XWC*SH*(SH-SQMZ)/((SH-SQMZ)**2+SQMZ*PMAS(23,2)**2)
3574 ZRATI=XWC*SH*PMAS(23,1)*PMAS(23,2)/
3575 & ((SH-SQMZ)**2+SQMZ*PMAS(23,2)**2)
3576 KFF=IABS(KFPR(ISUB,1))
3577 EF=KCHG(KFF,1)/3.
3578 AF=SIGN(1.,EF+0.1)
3579 VF=AF-4.*EF*XWV
3580 VALF=VF+AF
3581 VARF=VF-AF
3582 FCOF=1.
3583 IF(KFF.LE.10) FCOF=3.
3584 WID2=1.
3585 IF(KFF.EQ.6.AND.MSTP(48).GE.1) WID2=WIDS(26,1)
3586 IF((KFF.EQ.7.OR.KFF.EQ.8).AND.MSTP(49).GE.1) WID2=WIDS(KFF+20,1)
3587 IF((KFF.EQ.17.OR.KFF.EQ.18).AND.MSTP(49).GE.1) WID2=
3588 & WIDS(KFF+12,1)
3589 DO 1470 I=MMINA,MMAXA
3590 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1470
3591 EI=KCHG(IABS(I),1)/3.
3592 AI=SIGN(1.,EI+0.1)
3593 VI=AI-4.*EI*XWV
3594 VALI=VI+AI
3595 VARI=VI-AI
3596 FCOI=1.
3597 IF(IABS(I).LE.10) FCOI=FACA/3.
3598 IF((MSTP(5).EQ.1.AND.IABS(I).LE.2).OR.MSTP(5).EQ.2) THEN
3599 FGZA=(EI*EF+VALI*VALF*ZRATR+PARU(156)*SH/
3600 & (AEM*PARU(155)**2))**2+(VALI*VALF*ZRATI)**2+
3601 & (EI*EF+VARI*VARF*ZRATR)**2+(VARI*VARF*ZRATI)**2
3602 ELSE
3603 FGZA=(EI*EF+VALI*VALF*ZRATR)**2+(VALI*VALF*ZRATI)**2+
3604 & (EI*EF+VARI*VARF*ZRATR)**2+(VARI*VARF*ZRATI)**2
3605 ENDIF
3606 FGZB=(EI*EF+VALI*VARF*ZRATR)**2+(VALI*VARF*ZRATI)**2+
3607 & (EI*EF+VARI*VALF*ZRATR)**2+(VARI*VALF*ZRATI)**2
3608 FGZAB=AEM**2*(FGZA*UH2/SH2+FGZB*TH2/SH2)
3609 IF((MSTP(5).EQ.3.AND.IABS(I).EQ.2).OR.(MSTP(5).EQ.4.AND.
3610 & MOD(IABS(I),2).EQ.0)) FGZAB=FGZAB+SH2/(2.*PARU(155)**4)
3611 NCHN=NCHN+1
3612 ISIG(NCHN,1)=I
3613 ISIG(NCHN,2)=-I
3614 ISIG(NCHN,3)=1
3615 SIGH(NCHN)=COMFAC*FCOI*FCOF*FGZAB*WID2
3616 1470 CONTINUE
3617
3618 ELSEIF(ISUB.EQ.166) THEN
3619C...q + q'~ -> l + nu_l (including contact term for compositeness).
3620 WFAC=(1./4.)*(AEM/XW)**2*UH2/((SH-SQMW)**2+SQMW*PMAS(24,2)**2)
3621 WCIFAC=WFAC+SH2/(4.*PARU(155)**4)
3622 KFF=IABS(KFPR(ISUB,1))
3623 FCOF=1.
3624 IF(KFF.LE.10) FCOF=3.
3625 DO 1490 I=MMIN1,MMAX1
3626 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 1490
3627 IA=IABS(I)
3628 DO 1480 J=MMIN2,MMAX2
3629 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 1480
3630 JA=IABS(J)
3631 IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 1480
3632 IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) GOTO 1480
3633 FCOI=1.
3634 IF(IA.LE.10) FCOI=VCKM((IA+1)/2,(JA+1)/2)*FACA/3.
3635 WID2=1.
3636 IF((I.GT.0.AND.MOD(I,2).EQ.0).OR.(J.GT.0.AND.MOD(J,2).EQ.0))
3637 & THEN
3638 IF(KFF.EQ.5.AND.MSTP(48).GE.1) WID2=WIDS(26,2)
3639 IF(KFF.EQ.7.AND.MSTP(49).GE.1) WID2=WIDS(28,2)*WIDS(27,3)
3640 IF(KFF.EQ.17.AND.MSTP(49).GE.1) WID2=WIDS(30,2)*WIDS(29,3)
3641 ELSE
3642 IF(KFF.EQ.5.AND.MSTP(48).GE.1) WID2=WIDS(26,3)
3643 IF(KFF.EQ.7.AND.MSTP(49).GE.1) WID2=WIDS(28,3)*WIDS(27,2)
3644 IF(KFF.EQ.17.AND.MSTP(49).GE.1) WID2=WIDS(30,3)*WIDS(29,2)
3645 ENDIF
3646 NCHN=NCHN+1
3647 ISIG(NCHN,1)=I
3648 ISIG(NCHN,2)=J
3649 ISIG(NCHN,3)=1
3650 SIGH(NCHN)=COMFAC*FCOI*FCOF*WFAC*WID2
3651 IF((MSTP(5).EQ.3.AND.IA.LE.2.AND.JA.LE.2).OR.MSTP(5).EQ.4)
3652 & SIGH(NCHN)=COMFAC*FCOI*FCOF*WCIFAC*WID2
3653 1480 CONTINUE
3654 1490 CONTINUE
3655
3656 ELSEIF(ISUB.EQ.167.OR.ISUB.EQ.168) THEN
3657C...d + g -> d* and u + g -> u* (excited quarks).
3658 KFQEXC=ISUB-166
3659 KFQSTR=ISUB-160
3660 FACQSA=COMFAC*(SH/PARU(155)**2)**2*(1.-SQM4/SH)
3661 FACQSB=COMFAC*0.25*(SH/PARU(155)**2)**2*(1.-SQM4/SH)*
3662 & (1.+SQM4/SH)*(1.+CTH)*(1.+((SH-SQM4)/(SH+SQM4))*CTH)
3663C...Propagators: as simulated in PYOFSH and as desired.
3664 GMMQ=PMAS(KFQSTR,1)*PMAS(KFQSTR,2)
3665 HBW4=GMMQ/((SQM4-PMAS(KFQSTR,1)**2)**2+GMMQ**2)
3666 CALL PYWIDT(KFQSTR,SQM4,WDTP,WDTE)
3667 GMMQC=SQM4*WDTP(0)
3668 HBW4C=GMMQC/((SQM4-PMAS(KFQSTR,1)**2)**2+GMMQC**2)
3669 FACQSA=FACQSA*HBW4C/HBW4
3670 FACQSB=FACQSB*HBW4C/HBW4
3671 DO 1510 I=MMIN1,MMAX1
3672 IA=IABS(I)
3673 IF(I.EQ.0.OR.IA.GT.6.OR.KFAC(1,I).EQ.0) GOTO 1510
3674 DO 1500 J=MMIN2,MMAX2
3675 JA=IABS(J)
3676 IF(J.EQ.0.OR.JA.GT.6.OR.KFAC(2,J).EQ.0) GOTO 1500
3677 IF(IA.EQ.KFQEXC.AND.I.EQ.J) THEN
3678 NCHN=NCHN+1
3679 ISIG(NCHN,1)=I
3680 ISIG(NCHN,2)=J
3681 ISIG(NCHN,3)=1
3682 SIGH(NCHN)=(4./3.)*FACQSA
3683 NCHN=NCHN+1
3684 ISIG(NCHN,1)=I
3685 ISIG(NCHN,2)=J
3686 ISIG(NCHN,3)=2
3687 SIGH(NCHN)=(4./3.)*FACQSA
3688 ELSEIF((IA.EQ.KFQEXC.OR.JA.EQ.KFQEXC).AND.I*J.GT.0) THEN
3689 NCHN=NCHN+1
3690 ISIG(NCHN,1)=I
3691 ISIG(NCHN,2)=J
3692 ISIG(NCHN,3)=1
3693 IF(JA.EQ.KFQEXC) ISIG(NCHN,3)=2
3694 SIGH(NCHN)=FACQSA
3695 ELSEIF(IA.EQ.KFQEXC.AND.I.EQ.-J) THEN
3696 NCHN=NCHN+1
3697 ISIG(NCHN,1)=I
3698 ISIG(NCHN,2)=J
3699 ISIG(NCHN,3)=1
3700 SIGH(NCHN)=(8./3.)*FACQSB
3701 NCHN=NCHN+1
3702 ISIG(NCHN,1)=I
3703 ISIG(NCHN,2)=J
3704 ISIG(NCHN,3)=2
3705 SIGH(NCHN)=(8./3.)*FACQSB
3706 ELSEIF(I.EQ.-J) THEN
3707 NCHN=NCHN+1
3708 ISIG(NCHN,1)=I
3709 ISIG(NCHN,2)=J
3710 ISIG(NCHN,3)=1
3711 SIGH(NCHN)=FACQSB
3712 NCHN=NCHN+1
3713 ISIG(NCHN,1)=I
3714 ISIG(NCHN,2)=J
3715 ISIG(NCHN,3)=2
3716 SIGH(NCHN)=FACQSB
3717 ELSEIF(IA.EQ.KFQEXC.OR.JA.EQ.KFQEXC) THEN
3718 NCHN=NCHN+1
3719 ISIG(NCHN,1)=I
3720 ISIG(NCHN,2)=J
3721 ISIG(NCHN,3)=1
3722 IF(JA.EQ.KFQEXC) ISIG(NCHN,3)=2
3723 SIGH(NCHN)=FACQSB
3724 ENDIF
3725 1500 CONTINUE
3726 1510 CONTINUE
3727
3728 ENDIF
3729 ENDIF
3730
3731C...Multiply with structure functions.
3732 IF(ISUB.LE.90.OR.ISUB.GE.96) THEN
3733 DO 1520 ICHN=1,NCHN
3734 IF(MINT(45).GE.2) THEN
3735 KFL1=ISIG(ICHN,1)
3736 SIGH(ICHN)=SIGH(ICHN)*XSFX(1,KFL1)
3737 ENDIF
3738 IF(MINT(46).GE.2) THEN
3739 KFL2=ISIG(ICHN,2)
3740 SIGH(ICHN)=SIGH(ICHN)*XSFX(2,KFL2)
3741 ENDIF
3742 SIGS=SIGS+SIGH(ICHN)
3743 1520 CONTINUE
3744 ENDIF
3745
3746 RETURN
3747 END