]> git.uio.no Git - u/mrichter/AliRoot.git/blame - PYTHIA/pythia/pywidt.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Corrections needed when AliH2F was moved to CONTAINERS
[u/mrichter/AliRoot.git] / PYTHIA / pythia / pywidt.F
CommitLineData
fe4da5cc 1
2C*********************************************************************
3
4 SUBROUTINE PYWIDT(KFLR,SH,WDTP,WDTE)
5
6C...Calculates full and partial widths of resonances.
7 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
8 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
9 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
10 COMMON/PYSUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
11 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
12 COMMON/PYINT1/MINT(400),VINT(400)
13 COMMON/PYINT4/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3)
14 SAVE /LUDAT1/,/LUDAT2/,/LUDAT3/
15 SAVE /PYSUBS/,/PYPARS/,/PYINT1/,/PYINT4/
16 DIMENSION WDTP(0:40),WDTE(0:40,0:5),MOFSV(3,2),WIDWSV(3,2),
17 &WID2SV(3,2)
18 SAVE MOFSV,WIDWSV,WID2SV
19 DATA MOFSV/6*0/,WIDWSV/6*0./,WID2SV/6*0./
20
21C...Some common constants.
22 KFLA=IABS(KFLR)
23 KFHIGG=25
24 IHIGG=1
25 IF(KFLA.EQ.35.OR.KFLA.EQ.36) THEN
26 KFHIGG=KFLA
27 IHIGG=KFLA-33
28 ENDIF
29 XW=PARU(102)
30 XWV=XW
31 IF(MSTP(8).GE.2) XW=1.-(PMAS(24,1)/PMAS(23,1))**2
32 XW1=1.-XW
33 AEM=ULALEM(SH)
34 IF(MSTP(8).GE.1) AEM=SQRT(2.)*PARU(105)*PMAS(24,1)**2*XW/PARU(1)
35 AS=ULALPS(SH)
36 RADC=1.+AS/PARU(1)
37
38C...Reset width information.
39 DO 110 I=0,40
40 WDTP(I)=0.
41 DO 100 J=0,5
42 WDTE(I,J)=0.
43 100 CONTINUE
44 110 CONTINUE
45
46 IF(KFLA.EQ.6) THEN
47C...t quark.
48 DO 120 I=1,MDCY(6,3)
49 IDC=I+MDCY(6,2)-1
50 IF(MDME(IDC,1).LT.0) GOTO 120
51 RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH
52 RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH
53 IF(SQRT(RM1)+SQRT(RM2).GT.1.) GOTO 120
54 IF(I.GE.4.AND.I.LE.7) THEN
55C...t -> W + q.
56 WDTP(I)=AEM*SH/(16.*PMAS(24,1)**2*XW)*VCKM(3,I-3)*
57 & SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))*
58 & ((1.-RM2)**2+(1.+RM2)*RM1-2.*RM1**2)
59 IF(KFLR.GT.0) THEN
60 WID2=WIDS(24,2)
61 IF(I.EQ.7.AND.MSTP(49).GE.1) WID2=WID2*WIDS(27,2)
62 ELSE
63 WID2=WIDS(24,3)
64 IF(I.EQ.7.AND.MSTP(49).GE.1) WID2=WID2*WIDS(27,3)
65 ENDIF
66 ELSEIF(I.EQ.9) THEN
67C...t -> H + b.
68 WDTP(I)=AEM*SH/(16.*PMAS(24,1)**2*XW)*
69 & SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))*
70 & ((1.+RM2-RM1)*(RM2*PARU(141)**2+1./PARU(141)**2)+4.*RM2)
71 WID2=WIDS(37,2)
72 IF(KFLR.LT.0) WID2=WIDS(37,3)
73 ENDIF
74 WDTP(0)=WDTP(0)+WDTP(I)
75 IF(MDME(IDC,1).GT.0) THEN
76 WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
77 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
78 WDTE(I,0)=WDTE(I,MDME(IDC,1))
79 WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
80 ENDIF
81 120 CONTINUE
82
83 ELSEIF(KFLA.EQ.7) THEN
84C...l or d* (masked as particle code 7).
85 DO 130 I=1,MDCY(7,3)
86 IDC=I+MDCY(7,2)-1
87 IF(MDME(IDC,1).LT.0) GOTO 130
88 RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH
89 RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH
90 IF(SQRT(RM1)+SQRT(RM2).GT.1.) GOTO 130
91 IF(MSTP(6).NE.1) THEN
92 IF(I.GE.4.AND.I.LE.7) THEN
93C...l -> W + q.
94 WDTP(I)=AEM*SH/(16.*PMAS(24,1)**2*XW)*VCKM(I-3,4)*
95 & SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))*
96 & ((1.-RM2)**2+(1.+RM2)*RM1-2.*RM1**2)
97 IF(KFLR.GT.0) THEN
98 WID2=WIDS(24,3)
99 IF(I.EQ.6.AND.MSTP(48).GE.1) WID2=WID2*WIDS(26,2)
100 IF(I.EQ.7.AND.MSTP(49).GE.1) WID2=WID2*WIDS(28,2)
101 ELSE
102 WID2=WIDS(24,2)
103 IF(I.EQ.6.AND.MSTP(48).GE.1) WID2=WID2*WIDS(26,3)
104 IF(I.EQ.7.AND.MSTP(49).GE.1) WID2=WID2*WIDS(28,3)
105 ENDIF
106 WID2=WIDS(24,3)
107 IF(KFLR.LT.0) WID2=WIDS(24,2)
108 ELSEIF(I.EQ.9.OR.I.EQ.10) THEN
109C...l -> H + q.
110 WDTP(I)=AEM*SH/(16.*PMAS(24,1)**2*XW)*
111 & SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))*
112 & ((1.+RM2-RM1)*(PARU(141)**2+RM2/PARU(141)**2)+4.*RM2)
113 IF(KFLR.GT.0) THEN
114 WID2=WIDS(37,3)
115 IF(I.EQ.10.AND.MSTP(48).GE.1) WID2=WID2*WIDS(26,2)
116 ELSE
117 WID2=WIDS(37,2)
118 IF(I.EQ.10.AND.MSTP(48).GE.1) WID2=WID2*WIDS(26,3)
119 ENDIF
120 ENDIF
121 ELSE
122 IF(I.EQ.1) THEN
123C...d* -> g + d.
124 WDTP(I)=AS*PARU(159)**2*SH/(3.*PARU(155)**2)
125 WID2=1.
126 ELSEIF(I.EQ.2) THEN
127C...d* -> gamma + d.
128 QF=-PARU(157)/2.+PARU(158)/6.
129 WDTP(I)=AEM*QF**2*SH/(4.*PARU(155)**2)
130 WID2=1.
131 ELSEIF(I.EQ.3) THEN
132C...d* -> Z0 + d.
133 QF=-PARU(157)*XW1/2.-PARU(158)*XW/6.
134 WDTP(I)=AEM*QF**2*SH/(8.*XW*XW1*PARU(155)**2)*
135 & (1.-RM1)**2*(2.+RM1)
136 WID2=WIDS(23,2)
137 ELSEIF(I.EQ.4) THEN
138C...d* -> W- + u.
139 WDTP(I)=AEM*PARU(157)**2*SH/(16.*XW*PARU(155)**2)*
140 & (1.-RM1)**2*(2.+RM1)
141 IF(KFLR.GT.0) WID2=WIDS(24,3)
142 IF(KFLR.LT.0) WID2=WIDS(24,2)
143 ENDIF
144 ENDIF
145 WDTP(0)=WDTP(0)+WDTP(I)
146 IF(MDME(IDC,1).GT.0) THEN
147 WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
148 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
149 WDTE(I,0)=WDTE(I,MDME(IDC,1))
150 WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
151 ENDIF
152 130 CONTINUE
153
154 ELSEIF(KFLA.EQ.8) THEN
155C...h or u* (masked as particle code 8).
156 DO 140 I=1,MDCY(8,3)
157 IDC=I+MDCY(8,2)-1
158 IF(MDME(IDC,1).LT.0) GOTO 140
159 RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH
160 RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH
161 IF(SQRT(RM1)+SQRT(RM2).GT.1.) GOTO 140
162 IF(MSTP(6).NE.1) THEN
163 IF(I.GE.4.AND.I.LE.7) THEN
164C...h -> W + q.
165 WDTP(I)=AEM*SH/(16.*PMAS(24,1)**2*XW)*VCKM(4,I-3)*
166 & SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))*
167 & ((1.-RM2)**2+(1.+RM2)*RM1-2.*RM1**2)
168 IF(KFLR.GT.0) THEN
169 WID2=WIDS(24,2)
170 IF(I.EQ.7.AND.MSTP(49).GE.1) WID2=WID2*WIDS(27,2)
171 ELSE
172 WID2=WIDS(24,3)
173 IF(I.EQ.7.AND.MSTP(49).GE.1) WID2=WID2*WIDS(27,3)
174 ENDIF
175 ELSEIF(I.EQ.9.OR.I.EQ.10) THEN
176C...h -> H + q.
177 WDTP(I)=AEM*SH/(16.*PMAS(24,1)**2*XW)*
178 & SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))*
179 & ((1.+RM2-RM1)*(RM2*PARU(141)**2+1./PARU(141)**2)+4.*RM2)
180 IF(KFLR.GT.0) THEN
181 WID2=WIDS(37,2)
182 IF(I.EQ.10.AND.MSTP(49).GE.1) WID2=WID2*WIDS(27,2)
183 ELSE
184 WID2=WIDS(37,3)
185 IF(I.EQ.10.AND.MSTP(49).GE.1) WID2=WID2*WIDS(27,3)
186 ENDIF
187 ENDIF
188 ELSE
189 IF(I.EQ.1) THEN
190C...u* -> g + u.
191 WDTP(I)=AS*PARU(159)**2*SH/(3.*PARU(155)**2)
192 WID2=1.
193 ELSEIF(I.EQ.2) THEN
194C...u* -> gamma + u.
195 QF=PARU(157)/2.+PARU(158)/6.
196 WDTP(I)=AEM*QF**2*SH/(4.*PARU(155)**2)
197 WID2=1.
198 ELSEIF(I.EQ.3) THEN
199C...u* -> Z0 + u.
200 QF=PARU(157)*XW1/2.-PARU(158)*XW/6.
201 WDTP(I)=AEM*QF**2*SH/(8.*XW*XW1*PARU(155)**2)*
202 & (1.-RM1)**2*(2.+RM1)
203 WID2=WIDS(23,2)
204 ELSEIF(I.EQ.4) THEN
205C...u* -> W+ + d.
206 WDTP(I)=AEM*PARU(157)**2*SH/(16.*XW*PARU(155)**2)*
207 & (1.-RM1)**2*(2.+RM1)
208 IF(KFLR.GT.0) WID2=WIDS(24,2)
209 IF(KFLR.LT.0) WID2=WIDS(24,3)
210 ENDIF
211 ENDIF
212 WDTP(0)=WDTP(0)+WDTP(I)
213 IF(MDME(IDC,1).GT.0) THEN
214 WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
215 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
216 WDTE(I,0)=WDTE(I,MDME(IDC,1))
217 WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
218 ENDIF
219 140 CONTINUE
220
221 ELSEIF(KFLA.EQ.17) THEN
222C...chi or e* (masked as particle code 17).
223 DO 150 I=1,MDCY(17,3)
224 IDC=I+MDCY(17,2)-1
225 IF(MDME(IDC,1).LT.0) GOTO 150
226 RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH
227 RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH
228 IF(SQRT(RM1)+SQRT(RM2).GT.1.) GOTO 150
229 IF(MSTP(6).NE.1) THEN
230 IF(I.EQ.4) THEN
231C...chi -> W + nu_chi.
232 WDTP(I)=AEM*SH/(16.*PMAS(24,1)**2*XW)*
233 & SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))*
234 & ((1.-RM2)**2+(1.+RM2)*RM1-2.*RM1**2)
235 IF(KFLR.GT.0) THEN
236 WID2=WIDS(24,3)
237 IF(MSTP(49).GE.1) WID2=WID2*WIDS(30,2)
238 ELSE
239 WID2=WIDS(24,2)
240 IF(MSTP(49).GE.1) WID2=WID2*WIDS(30,3)
241 ENDIF
242 ELSEIF(I.EQ.6) THEN
243C...chi -> H + nu_chi.
244 WDTP(I)=AEM*SH/(16.*PMAS(24,1)**2*XW)*
245 & SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))*
246 & ((1.+RM2-RM1)*(PARU(141)**2+RM2/PARU(141)**2)+4.*RM2)
247 IF(KFLR.GT.0) THEN
248 WID2=WIDS(37,3)
249 IF(MSTP(49).GE.1) WID2=WID2*WIDS(30,2)
250 ELSE
251 WID2=WIDS(37,2)
252 IF(MSTP(49).GE.1) WID2=WID2*WIDS(30,3)
253 ENDIF
254 ENDIF
255 ELSE
256 IF(I.EQ.2) THEN
257C...e* -> gamma + e.
258 QF=-PARU(157)/2.-PARU(158)/2.
259 WDTP(I)=AEM*QF**2*SH/(4.*PARU(155)**2)
260 WID2=1.
261 ELSEIF(I.EQ.3) THEN
262C...e* -> Z0 + e.
263 QF=-PARU(157)*XW1/2.+PARU(158)*XW/2.
264 WDTP(I)=AEM*QF**2*SH/(8.*XW*XW1*PARU(155)**2)*
265 & (1.-RM1)**2*(2.+RM1)
266 WID2=WIDS(23,2)
267 ELSEIF(I.EQ.4) THEN
268C...e* -> W- + nu.
269 WDTP(I)=AEM*PARU(157)**2*SH/(16.*XW*PARU(155)**2)*
270 & (1.-RM1)**2*(2.+RM1)
271 IF(KFLR.GT.0) WID2=WIDS(24,3)
272 IF(KFLR.LT.0) WID2=WIDS(24,2)
273 ENDIF
274 ENDIF
275 WDTP(0)=WDTP(0)+WDTP(I)
276 IF(MDME(IDC,1).GT.0) THEN
277 WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
278 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
279 WDTE(I,0)=WDTE(I,MDME(IDC,1))
280 WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
281 ENDIF
282 150 CONTINUE
283
284 ELSEIF(KFLA.EQ.18) THEN
285C...nu_chi or nu*_e (masked as particle code 18).
286 DO 160 I=1,MDCY(18,3)
287 IDC=I+MDCY(18,2)-1
288 IF(MDME(IDC,1).LT.0) GOTO 160
289 RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH
290 RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH
291 IF(SQRT(RM1)+SQRT(RM2).GT.1.) GOTO 160
292 IF(MSTP(6).NE.1) THEN
293 IF(I.EQ.2) THEN
294C...nu_chi -> W + chi.
295 WDTP(I)=AEM*SH/(16.*PMAS(24,1)**2*XW)*
296 & SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))*
297 & ((1.-RM2)**2+(1.+RM2)*RM1-2.*RM1**2)
298 IF(KFLR.GT.0) THEN
299 WID2=WIDS(24,2)
300 IF(MSTP(49).GE.1) WID2=WID2*WIDS(29,2)
301 ELSE
302 WID2=WIDS(24,3)
303 IF(MSTP(49).GE.1) WID2=WID2*WIDS(29,3)
304 ENDIF
305 ELSEIF(I.EQ.3) THEN
306C...nu_chi -> H + chi.
307 WDTP(I)=AEM*SH/(16.*PMAS(24,1)**2*XW)*
308 & SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))*
309 & ((1.+RM2-RM1)*(RM2*PARU(141)**2+1./PARU(141)**2)+4.*RM2)
310 IF(KFLR.GT.0) THEN
311 WID2=WIDS(37,2)
312 IF(MSTP(49).GE.1) WID2=WID2*WIDS(29,2)
313 ELSE
314 WID2=WIDS(37,3)
315 IF(MSTP(49).GE.1) WID2=WID2*WIDS(29,3)
316 ENDIF
317 ENDIF
318 ELSE
319 IF(I.EQ.1) THEN
320C...nu*_e -> Z0 + nu*_e.
321 QF=PARU(157)*XW1/2.+PARU(158)*XW/2.
322 WDTP(I)=AEM*QF**2*SH/(8.*XW*XW1*PARU(155)**2)*
323 & (1.-RM1)**2*(2.+RM1)
324 WID2=WIDS(23,2)
325 ELSEIF(I.EQ.2) THEN
326C...nu*_e -> W+ + e.
327 WDTP(I)=AEM*PARU(157)**2*SH/(16.*XW*PARU(155)**2)*
328 & (1.-RM1)**2*(2.+RM1)
329 IF(KFLR.GT.0) WID2=WIDS(24,2)
330 IF(KFLR.LT.0) WID2=WIDS(24,3)
331 ENDIF
332 ENDIF
333 WDTP(0)=WDTP(0)+WDTP(I)
334 IF(MDME(IDC,1).GT.0) THEN
335 WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
336 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
337 WDTE(I,0)=WDTE(I,MDME(IDC,1))
338 WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
339 ENDIF
340 160 CONTINUE
341
342 ELSEIF(KFLA.EQ.21) THEN
343C...QCD:
344 DO 170 I=1,MDCY(21,3)
345 IDC=I+MDCY(21,2)-1
346 IF(MDME(IDC,1).LT.0) GOTO 170
347 RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH
348 RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH
349 IF(SQRT(RM1)+SQRT(RM2).GT.1.) GOTO 170
350 WID2=1.
351 IF(I.LE.8) THEN
352C...QCD -> q + q~
353 WDTP(I)=(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))
354 IF(I.EQ.6.AND.MSTP(48).GE.1) WID2=WIDS(26,1)
355 IF((I.EQ.7.OR.I.EQ.8).AND.MSTP(49).GE.1) WID2=WIDS(20+I,1)
356 ENDIF
357 WDTP(0)=WDTP(0)+WDTP(I)
358 IF(MDME(IDC,1).GT.0) THEN
359 WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
360 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
361 WDTE(I,0)=WDTE(I,MDME(IDC,1))
362 WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
363 ENDIF
364 170 CONTINUE
365
366 ELSEIF(KFLA.EQ.22) THEN
367C...QED photon.
368 DO 180 I=1,MDCY(22,3)
369 IDC=I+MDCY(22,2)-1
370 IF(MDME(IDC,1).LT.0) GOTO 180
371 RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH
372 RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH
373 IF(SQRT(RM1)+SQRT(RM2).GT.1.) GOTO 180
374 WID2=1.
375 IF(I.LE.8) THEN
376C...QED -> q + q~.
377 EF=KCHG(I,1)/3.
378 FCOF=3.*RADC
379 IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF*PYHFTH(SH,SH*RM1,1.)
380 WDTP(I)=FCOF*EF**2*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))
381 IF(I.EQ.6.AND.MSTP(48).GE.1) WID2=WIDS(26,1)
382 IF((I.EQ.7.OR.I.EQ.8).AND.MSTP(49).GE.1) WID2=WIDS(20+I,1)
383 ELSEIF(I.LE.12) THEN
384C...QED -> l+ + l-.
385 EF=KCHG(9+2*(I-8),1)/3.
386 WDTP(I)=EF**2*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))
387 IF(I.EQ.12.AND.MSTP(49).GE.1) WID2=WIDS(29,1)
388 ENDIF
389 WDTP(0)=WDTP(0)+WDTP(I)
390 IF(MDME(IDC,1).GT.0) THEN
391 WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
392 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
393 WDTE(I,0)=WDTE(I,MDME(IDC,1))
394 WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
395 ENDIF
396 180 CONTINUE
397
398 ELSEIF(KFLA.EQ.23) THEN
399C...Z0:
400 ICASE=1
401 XWC=1./(16.*XW*XW1)
402 FACH=AEM/3.*XWC*SH
403 190 CONTINUE
404 IF(MINT(61).GE.1.AND.ICASE.EQ.2) THEN
405 VINT(111)=0.
406 VINT(112)=0.
407 VINT(114)=0.
408 ENDIF
409 IF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN
410 EI=KCHG(IABS(MINT(15)),1)/3.
411 AI=SIGN(1.,EI)
412 VI=AI-4.*EI*XWV
413 SQMZ=PMAS(23,1)**2
414 HZ=FACH*WDTP(0)
415 IF(MSTP(43).EQ.1.OR.MSTP(43).EQ.3) VINT(111)=1.
416 IF(MSTP(43).EQ.3) VINT(112)=
417 & 2.*XWC*SH*(SH-SQMZ)/((SH-SQMZ)**2+HZ**2)
418 IF(MSTP(43).EQ.2.OR.MSTP(43).EQ.3) VINT(114)=
419 & XWC**2*SH**2/((SH-SQMZ)**2+HZ**2)
420 ENDIF
421 DO 200 I=1,MDCY(23,3)
422 IDC=I+MDCY(23,2)-1
423 IF(MDME(IDC,1).LT.0) GOTO 200
424 RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH
425 RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH
426 IF(SQRT(RM1)+SQRT(RM2).GT.1.) GOTO 200
427 WID2=1.
428 IF(I.LE.8) THEN
429C...Z0 -> q + q~
430 EF=KCHG(I,1)/3.
431 AF=SIGN(1.,EF+0.1)
432 VF=AF-4.*EF*XWV
433 FCOF=3.*RADC
434 IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF*PYHFTH(SH,SH*RM1,1.)
435 IF(I.EQ.6.AND.MSTP(48).GE.1) WID2=WIDS(26,1)
436 IF((I.EQ.7.OR.I.EQ.8).AND.MSTP(49).GE.1) WID2=WIDS(20+I,1)
437 ELSEIF(I.LE.16) THEN
438C...Z0 -> l+ + l-, nu + nu~
439 EF=KCHG(I+2,1)/3.
440 AF=SIGN(1.,EF+0.1)
441 VF=AF-4.*EF*XWV
442 FCOF=1.
443 IF((I.EQ.15.OR.I.EQ.16).AND.MSTP(49).GE.1) WID2=WIDS(14+I,1)
444 ENDIF
445 BE34=SQRT(MAX(0.,1.-4.*RM1))
446 IF(ICASE.EQ.1) THEN
447 WDTP(I)=FCOF*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*BE34
448 ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN
449 WDTP(I)=FCOF*((EI**2*VINT(111)*EF**2+EI*VI*VINT(112)*
450 & EF*VF+(VI**2+AI**2)*VINT(114)*VF**2)*(1.+2.*RM1)+
451 & (VI**2+AI**2)*VINT(114)*AF**2*(1.-4.*RM1))*BE34
452 ELSEIF(MINT(61).EQ.2.AND.ICASE.EQ.2) THEN
453 FGGF=FCOF*EF**2*(1.+2.*RM1)*BE34
454 FGZF=FCOF*EF*VF*(1.+2.*RM1)*BE34
455 FZZF=FCOF*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*BE34
456 ENDIF
457 IF(ICASE.EQ.1) WDTP(0)=WDTP(0)+WDTP(I)
458 IF(MDME(IDC,1).GT.0) THEN
459 IF((ICASE.EQ.1.AND.MINT(61).NE.1).OR.
460 & (ICASE.EQ.2.AND.MINT(61).EQ.1)) THEN
461 WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
462 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
463 WDTE(I,0)=WDTE(I,MDME(IDC,1))
464 WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
465 ENDIF
466 IF(MINT(61).EQ.2.AND.ICASE.EQ.2) THEN
467 IF(MSTP(43).EQ.1.OR.MSTP(43).EQ.3) VINT(111)=
468 & VINT(111)+FGGF*WID2
469 IF(MSTP(43).EQ.3) VINT(112)=VINT(112)+FGZF*WID2
470 IF(MSTP(43).EQ.2.OR.MSTP(43).EQ.3) VINT(114)=
471 & VINT(114)+FZZF*WID2
472 ENDIF
473 ENDIF
474 200 CONTINUE
475 IF(MINT(61).GE.1) ICASE=3-ICASE
476 IF(ICASE.EQ.2) GOTO 190
477
478 ELSEIF(KFLA.EQ.24) THEN
479C...W+/-:
480 DO 210 I=1,MDCY(24,3)
481 IDC=I+MDCY(24,2)-1
482 IF(MDME(IDC,1).LT.0) GOTO 210
483 RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH
484 RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH
485 IF(SQRT(RM1)+SQRT(RM2).GT.1.) GOTO 210
486 WID2=1.
487 IF(I.LE.16) THEN
488C...W+/- -> q + q~'
489 FCOF=3.*RADC*VCKM((I-1)/4+1,MOD(I-1,4)+1)
490 IF(KFLR.GT.0) THEN
491 IF(MOD(I,4).EQ.3.AND.MSTP(48).GE.1) WID2=WIDS(26,2)
492 IF(MOD(I,4).EQ.0.AND.MSTP(49).GE.1) WID2=WIDS(28,2)
493 IF(I.GE.13.AND.MSTP(49).GE.1) WID2=WID2*WIDS(27,3)
494 ELSE
495 IF(MOD(I,4).EQ.3.AND.MSTP(48).GE.1) WID2=WIDS(26,3)
496 IF(MOD(I,4).EQ.0.AND.MSTP(49).GE.1) WID2=WIDS(28,3)
497 IF(I.GE.13.AND.MSTP(49).GE.1) WID2=WID2*WIDS(27,2)
498 ENDIF
499 ELSEIF(I.LE.20) THEN
500C...W+/- -> l+/- + nu
501 FCOF=1.
502 IF(KFLR.GT.0) THEN
503 IF(I.EQ.20.AND.MSTP(49).GE.1) WID2=WIDS(29,3)*WIDS(30,2)
504 ELSE
505 IF(I.EQ.20.AND.MSTP(49).GE.1) WID2=WIDS(29,2)*WIDS(30,3)
506 ENDIF
507 ENDIF
508 WDTP(I)=FCOF*(2.-RM1-RM2-(RM1-RM2)**2)*
509 & SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))
510 WDTP(0)=WDTP(0)+WDTP(I)
511 IF(MDME(IDC,1).GT.0) THEN
512 WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
513 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
514 WDTE(I,0)=WDTE(I,MDME(IDC,1))
515 WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
516 ENDIF
517 210 CONTINUE
518
519 ELSEIF(KFLA.EQ.25.OR.KFLA.EQ.35.OR.KFLA.EQ.36) THEN
520C...H0 (or H'0, or A0):
521 DO 250 I=1,MDCY(KFHIGG,3)
522 IDC=I+MDCY(KFHIGG,2)-1
523 IF(MDME(IDC,1).LT.0) GOTO 250
524 RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH
525 RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH
526 IF(I.NE.16.AND.I.NE.17.AND.SQRT(RM1)+SQRT(RM2).GT.1.) GOTO 250
527 WID2=1.
528
529 IF(I.LE.8) THEN
530C...H0 -> q + q~
531 WDTP(I)=3.*RM1*(1.-4.*RM1)*SQRT(MAX(0.,1.-4.*RM1))*RADC
532 IF(MSTP(37).EQ.1.AND.MSTP(2).GE.1) WDTP(I)=WDTP(I)*
533 & (LOG(MAX(4.,PARP(37)**2*RM1*SH/PARU(117)**2))/
534 & LOG(MAX(4.,SH/PARU(117)**2)))**(24./(33.-2.*MSTU(118)))
535 IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN
536 IF(MOD(I,2).EQ.1) WDTP(I)=WDTP(I)*PARU(151+10*IHIGG)**2
537 IF(MOD(I,2).EQ.0) WDTP(I)=WDTP(I)*PARU(152+10*IHIGG)**2
538 ENDIF
539 IF(I.EQ.6.AND.MSTP(48).GE.1) WID2=WIDS(26,1)
540 IF((I.EQ.7.OR.I.EQ.8).AND.MSTP(49).GE.1) WID2=WIDS(20+I,1)
541
542 ELSEIF(I.LE.12) THEN
543C...H0 -> l+ + l-
544 WDTP(I)=RM1*(1.-4.*RM1)*SQRT(MAX(0.,1.-4.*RM1))
545 IF(MSTP(4).GE.1.OR.IHIGG.GE.2) WDTP(I)=WDTP(I)*
546 & PARU(153+10*IHIGG)**2
547 IF(I.EQ.12.AND.MSTP(49).GE.1) WID2=WIDS(29,1)
548
549 ELSEIF(I.EQ.13) THEN
550C...H0 -> g + g; quark loop contribution only
551 ETARE=0.
552 ETAIM=0.
553 DO 220 J=1,2*MSTP(1)
554 EPS=(2.*PMAS(J,1))**2/SH
555C...Loop integral; function of eps=4m^2/shat; different for A0.
556 IF(EPS.LE.1.) THEN
557 IF(EPS.GT.1.E-4) THEN
558 ROOT=SQRT(1.-EPS)
559 RLN=LOG((1.+ROOT)/(1.-ROOT))
560 ELSE
561 RLN=LOG(4./EPS-2.)
562 ENDIF
563 PHIRE=-0.25*(RLN**2-PARU(1)**2)
564 PHIIM=0.5*PARU(1)*RLN
565 ELSE
566 PHIRE=(ASIN(1./SQRT(EPS)))**2
567 PHIIM=0.
568 ENDIF
569 IF(IHIGG.LE.2) THEN
570 ETAREJ=-0.5*EPS*(1.+(1.-EPS)*PHIRE)
571 ETAIMJ=-0.5*EPS*(1.-EPS)*PHIIM
572 ELSE
573 ETAREJ=-0.5*EPS*PHIRE
574 ETAIMJ=-0.5*EPS*PHIIM
575 ENDIF
576C...Couplings (=1 for standard model Higgs).
577 IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN
578 IF(MOD(J,2).EQ.1) THEN
579 ETAREJ=ETAREJ*PARU(151+10*IHIGG)
580 ETAIMJ=ETAIMJ*PARU(151+10*IHIGG)
581 ELSE
582 ETAREJ=ETAREJ*PARU(152+10*IHIGG)
583 ETAIMJ=ETAIMJ*PARU(152+10*IHIGG)
584 ENDIF
585 ENDIF
586 ETARE=ETARE+ETAREJ
587 ETAIM=ETAIM+ETAIMJ
588 220 CONTINUE
589 ETA2=ETARE**2+ETAIM**2
590 WDTP(I)=(AS/PARU(1))**2*ETA2
591
592 ELSEIF(I.EQ.14) THEN
593C...H0 -> gamma + gamma; quark, lepton, W+- and H+- loop contributions
594 ETARE=0.
595 ETAIM=0.
596 JMAX=3*MSTP(1)+1
597 IF(MSTP(4).GE.1.OR.IHIGG.GE.2) JMAX=JMAX+1
598 DO 230 J=1,JMAX
599 IF(J.LE.2*MSTP(1)) THEN
600 EJ=KCHG(J,1)/3.
601 EPS=(2.*PMAS(J,1))**2/SH
602 ELSEIF(J.LE.3*MSTP(1)) THEN
603 JL=2*(J-2*MSTP(1))-1
604 EJ=KCHG(10+JL,1)/3.
605 EPS=(2.*PMAS(10+JL,1))**2/SH
606 ELSEIF(J.EQ.3*MSTP(1)+1) THEN
607 EPS=(2.*PMAS(24,1))**2/SH
608 ELSE
609 EPS=(2.*PMAS(37,1))**2/SH
610 ENDIF
611C...Loop integral; function of eps=4m^2/shat.
612 IF(EPS.LE.1.) THEN
613 IF(EPS.GT.1.E-4) THEN
614 ROOT=SQRT(1.-EPS)
615 RLN=LOG((1.+ROOT)/(1.-ROOT))
616 ELSE
617 RLN=LOG(4./EPS-2.)
618 ENDIF
619 PHIRE=-0.25*(RLN**2-PARU(1)**2)
620 PHIIM=0.5*PARU(1)*RLN
621 ELSE
622 PHIRE=(ASIN(1./SQRT(EPS)))**2
623 PHIIM=0.
624 ENDIF
625 IF(J.LE.3*MSTP(1)) THEN
626C...Fermion loops: loop integral different for A0; charges.
627 IF(IHIGG.LE.2) THEN
628 PHIPRE=-0.5*EPS*(1.+(1.-EPS)*PHIRE)
629 PHIPIM=-0.5*EPS*(1.-EPS)*PHIIM
630 ELSE
631 PHIPRE=-0.5*EPS*PHIRE
632 PHIPIM=-0.5*EPS*PHIIM
633 ENDIF
634 IF(J.LE.2*MSTP(1).AND.MOD(J,2).EQ.1) THEN
635 EJC=3.*EJ**2
636 EJH=PARU(151+10*IHIGG)
637 ELSEIF(J.LE.2*MSTP(1)) THEN
638 EJC=3.*EJ**2
639 EJH=PARU(152+10*IHIGG)
640 ELSE
641 EJC=EJ**2
642 EJH=PARU(153+10*IHIGG)
643 ENDIF
644 IF(MSTP(4).EQ.0.AND.IHIGG.EQ.1) EJH=1.
645 ETAREJ=EJC*EJH*PHIPRE
646 ETAIMJ=EJC*EJH*PHIPIM
647 ELSEIF(J.EQ.3*MSTP(1)+1) THEN
648C...W loops: loop integral and charges.
649 ETAREJ=0.5+0.75*EPS*(1.+(2.-EPS)*PHIRE)
650 ETAIMJ=0.75*EPS*(2.-EPS)*PHIIM
651 IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN
652 ETAREJ=ETAREJ*PARU(155+10*IHIGG)
653 ETAIMJ=ETAIMJ*PARU(155+10*IHIGG)
654 ENDIF
655 ELSE
656C...Charged H loops: loop integral and charges.
657 FACHHH=(PMAS(24,1)/PMAS(37,1))**2*
658 & PARU(158+10*IHIGG+2*(IHIGG/3))
659 ETAREJ=EPS*(1.-EPS*PHIRE)*FACHHH
660 ETAIMJ=-EPS**2*PHIIM*FACHHH
661 ENDIF
662 ETARE=ETARE+ETAREJ
663 ETAIM=ETAIM+ETAIMJ
664 230 CONTINUE
665 ETA2=ETARE**2+ETAIM**2
666 WDTP(I)=(AEM/PARU(1))**2*0.5*ETA2
667
668 ELSEIF(I.EQ.15) THEN
669C...H0 -> gamma + Z0; quark, lepton, W and H+- loop contributions
670 ETARE=0.
671 ETAIM=0.
672 JMAX=3*MSTP(1)+1
673 IF(MSTP(4).GE.1.OR.IHIGG.GE.2) JMAX=JMAX+1
674 DO 240 J=1,JMAX
675 IF(J.LE.2*MSTP(1)) THEN
676 EJ=KCHG(J,1)/3.
677 AJ=SIGN(1.,EJ+0.1)
678 VJ=AJ-4.*EJ*XWV
679 EPS=(2.*PMAS(J,1))**2/SH
680 EPSP=(2.*PMAS(J,1)/PMAS(23,1))**2
681 ELSEIF(J.LE.3*MSTP(1)) THEN
682 JL=2*(J-2*MSTP(1))-1
683 EJ=KCHG(10+JL,1)/3.
684 AJ=SIGN(1.,EJ+0.1)
685 VJ=AJ-4.*EJ*XWV
686 EPS=(2.*PMAS(10+JL,1))**2/SH
687 EPSP=(2.*PMAS(10+JL,1)/PMAS(23,1))**2
688 ELSE
689 EPS=(2.*PMAS(24,1))**2/SH
690 EPSP=(2.*PMAS(24,1)/PMAS(23,1))**2
691 ENDIF
692C...Loop integrals; functions of eps=4m^2/shat and eps'=4m^2/m_Z^2.
693 IF(EPS.LE.1.) THEN
694 ROOT=SQRT(1.-EPS)
695 IF(EPS.GT.1.E-4) THEN
696 RLN=LOG((1.+ROOT)/(1.-ROOT))
697 ELSE
698 RLN=LOG(4./EPS-2.)
699 ENDIF
700 PHIRE=-0.25*(RLN**2-PARU(1)**2)
701 PHIIM=0.5*PARU(1)*RLN
702 PSIRE=0.5*ROOT*RLN
703 PSIIM=-0.5*ROOT*PARU(1)
704 ELSE
705 PHIRE=(ASIN(1./SQRT(EPS)))**2
706 PHIIM=0.
707 PSIRE=SQRT(EPS-1.)*ASIN(1./SQRT(EPS))
708 PSIIM=0.
709 ENDIF
710 IF(EPSP.LE.1.) THEN
711 ROOT=SQRT(1.-EPSP)
712 IF(EPSP.GT.1.E-4) THEN
713 RLN=LOG((1.+ROOT)/(1.-ROOT))
714 ELSE
715 RLN=LOG(4./EPSP-2.)
716 ENDIF
717 PHIREP=-0.25*(RLN**2-PARU(1)**2)
718 PHIIMP=0.5*PARU(1)*RLN
719 PSIREP=0.5*ROOT*RLN
720 PSIIMP=-0.5*ROOT*PARU(1)
721 ELSE
722 PHIREP=(ASIN(1./SQRT(EPSP)))**2
723 PHIIMP=0.
724 PSIREP=SQRT(EPSP-1.)*ASIN(1./SQRT(EPSP))
725 PSIIMP=0.
726 ENDIF
727 FXYRE=EPS*EPSP/(8.*(EPS-EPSP))*(1.+EPS*EPSP/(EPS-EPSP)*(PHIRE-
728 & PHIREP)+2.*EPS/(EPS-EPSP)*(PSIRE-PSIREP))
729 FXYIM=EPS**2*EPSP/(8.*(EPS-EPSP)**2)*(EPSP*(PHIIM-PHIIMP)+
730 & 2.*(PSIIM-PSIIMP))
731 F1RE=-EPS*EPSP/(2.*(EPS-EPSP))*(PHIRE-PHIREP)
732 F1IM=-EPS*EPSP/(2.*(EPS-EPSP))*(PHIIM-PHIIMP)
733 IF(J.LE.3*MSTP(1)) THEN
734C...Fermion loops: loop integral different for A0; charges.
735 IF(IHIGG.EQ.3) FXYRE=0.
736 IF(IHIGG.EQ.3) FXYIM=0.
737 IF(J.LE.2*MSTP(1).AND.MOD(J,2).EQ.1) THEN
738 EJC=-3.*EJ*VJ
739 EJH=PARU(151+10*IHIGG)
740 ELSEIF(J.LE.2*MSTP(1)) THEN
741 EJC=-3.*EJ*VJ
742 EJH=PARU(152+10*IHIGG)
743 ELSE
744 EJC=-EJ*VJ
745 EJH=PARU(153+10*IHIGG)
746 ENDIF
747 IF(MSTP(4).EQ.0.AND.IHIGG.EQ.1) EJH=1.
748 ETAREJ=EJC*EJH*(FXYRE-0.25*F1RE)
749 ETAIMJ=EJC*EJH*(FXYIM-0.25*F1IM)
750 ELSEIF(J.EQ.3*MSTP(1)+1) THEN
751C...W loops: loop integral and charges.
752 HEPS=(1.+2./EPS)*XW/XW1-(5.+2./EPS)
753 ETAREJ=-XW1*((3.-XW/XW1)*F1RE+HEPS*FXYRE)
754 ETAIMJ=-XW1*((3.-XW/XW1)*F1IM+HEPS*FXYIM)
755 IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN
756 ETAREJ=ETAREJ*PARU(155+10*IHIGG)
757 ETAIMJ=ETAIMJ*PARU(155+10*IHIGG)
758 ENDIF
759 ELSE
760C...Charged H loops: loop integral and charges.
761 FACHHH=(PMAS(24,1)/PMAS(37,1))**2*(1.-2.*XW)*
762 & PARU(158+10*IHIGG+2*(IHIGG/3))
763 ETAREJ=FACHHH*FXYRE
764 ETAIMJ=FACHHH*FXYIM
765 ENDIF
766 ETARE=ETARE+ETAREJ
767 ETAIM=ETAIM+ETAIMJ
768 240 CONTINUE
769 ETA2=(ETARE**2+ETAIM**2)/(XW*XW1)
770 WDTP(I)=(AEM/PARU(1))**2*(1.-PMAS(23,1)**2/SH)**3*ETA2
771 WID2=WIDS(23,2)
772
773 ELSEIF(I.LE.17) THEN
774C...H0 -> Z0 + Z0, W+ + W-
775 PM1=PMAS(IABS(KFDP(IDC,1)),1)
776 PG1=PMAS(IABS(KFDP(IDC,1)),2)
777 IF(MINT(62).GE.1) THEN
778 IF(MSTP(42).EQ.0.OR.(4.*(PM1+10.*PG1)**2.LT.SH.AND.
779 & CKIN(46).LT.CKIN(45).AND.CKIN(48).LT.CKIN(47).AND.
780 & MAX(CKIN(45),CKIN(47)).LT.PM1-10.*PG1)) THEN
781 MOFSV(IHIGG,I-15)=0
782 WIDW=(1.-4.*RM1+12.*RM1**2)*SQRT(MAX(0.,1.-4.*RM1))
783 WID2=1.
784 ELSE
785 MOFSV(IHIGG,I-15)=1
786 RMAS=SQRT(MAX(0.,SH))
787 CALL PYOFSH(1,KFLA,KFDP(IDC,1),KFDP(IDC,2),RMAS,WIDW,WID2)
788 WIDWSV(IHIGG,I-15)=WIDW
789 WID2SV(IHIGG,I-15)=WID2
790 ENDIF
791 ELSE
792 IF(MOFSV(IHIGG,I-15).EQ.0) THEN
793 WIDW=(1.-4.*RM1+12.*RM1**2)*SQRT(MAX(0.,1.-4.*RM1))
794 WID2=1.
795 ELSE
796 WIDW=WIDWSV(IHIGG,I-15)
797 WID2=WID2SV(IHIGG,I-15)
798 ENDIF
799 ENDIF
800 WDTP(I)=WIDW/(2.*(18-I))
801 IF(MSTP(4).GE.1.OR.IHIGG.GE.2) WDTP(I)=WDTP(I)*
802 & PARU(138+I+10*IHIGG)**2
803 WID2=WID2*WIDS(7+I,1)
804
805 ELSEIF(I.EQ.18.AND.KFLA.EQ.35) THEN
806C***H'0 -> Z0 + H0 (not yet implemented).
807
808 ELSEIF(I.EQ.19.AND.KFLA.EQ.35) THEN
809C...H'0 -> H0 + H0.
810 WDTP(I)=PARU(176)**2*0.25*PMAS(23,1)**4/SH**2*
811 & SQRT(MAX(0.,1.-4.*RM1))
812 WID2=WIDS(25,2)**2
813
814 ELSEIF(I.EQ.20.AND.KFLA.EQ.35) THEN
815C...H'0 -> A0 + A0.
816 WDTP(I)=PARU(177)**2*0.25*PMAS(23,1)**4/SH**2*
817 & SQRT(MAX(0.,1.-4.*RM1))
818 WID2=WIDS(36,2)**2
819
820 ELSEIF(I.EQ.18.AND.KFLA.EQ.36) THEN
821C...A0 -> Z0 + H0.
822 WDTP(I)=PARU(186)**2*0.5*SQRT(MAX(0.,(1.-RM1-RM2)**2-
823 & 4.*RM1*RM2))**3
824 WID2=WIDS(23,2)*WIDS(25,2)
825 ENDIF
826 WDTP(0)=WDTP(0)+WDTP(I)
827 IF(MDME(IDC,1).GT.0) THEN
828 WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
829 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
830 WDTE(I,0)=WDTE(I,MDME(IDC,1))
831 WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
832 ENDIF
833 250 CONTINUE
834
835 ELSEIF(KFLA.EQ.32) THEN
836C...Z'0:
837 ICASE=1
838 XWC=1./(16.*XW*XW1)
839 FACH=AEM/3.*XWC*SH
840 VINT(117)=0.
841 260 CONTINUE
842 IF(MINT(61).GE.1.AND.ICASE.EQ.2) THEN
843 VINT(111)=0.
844 VINT(112)=0.
845 VINT(113)=0.
846 VINT(114)=0.
847 VINT(115)=0.
848 VINT(116)=0.
849 ENDIF
850 IF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN
851 KFAI=IABS(MINT(15))
852 EI=KCHG(KFAI,1)/3.
853 AI=SIGN(1.,EI+0.1)
854 VI=AI-4.*EI*XWV
855 KFAIC=1
856 IF(KFAI.LE.10.AND.MOD(KFAI,2).EQ.0) KFAIC=2
857 IF(KFAI.GT.10.AND.MOD(KFAI,2).NE.0) KFAIC=3
858 IF(KFAI.GT.10.AND.MOD(KFAI,2).EQ.0) KFAIC=4
859 VPI=PARU(119+2*KFAIC)
860 API=PARU(120+2*KFAIC)
861 SQMZ=PMAS(23,1)**2
862 HZ=FACH*VINT(117)
863 SQMZP=PMAS(32,1)**2
864 HZP=FACH*WDTP(0)
865 IF(MSTP(44).EQ.1.OR.MSTP(44).EQ.4.OR.MSTP(44).EQ.5.OR.
866 & MSTP(44).EQ.7) VINT(111)=1.
867 IF(MSTP(44).EQ.4.OR.MSTP(44).EQ.7) VINT(112)=
868 & 2.*XWC*SH*(SH-SQMZ)/((SH-SQMZ)**2+HZ**2)
869 IF(MSTP(44).EQ.5.OR.MSTP(44).EQ.7) VINT(113)=
870 & 2.*XWC*SH*(SH-SQMZP)/((SH-SQMZP)**2+HZP**2)
871 IF(MSTP(44).EQ.2.OR.MSTP(44).EQ.4.OR.MSTP(44).EQ.6.OR.
872 & MSTP(44).EQ.7) VINT(114)=XWC**2*SH**2/((SH-SQMZ)**2+HZ**2)
873 IF(MSTP(44).EQ.6.OR.MSTP(44).EQ.7) VINT(115)=
874 & 2.*XWC**2*SH**2*((SH-SQMZ)*(SH-SQMZP)+HZ*HZP)/
875 & (((SH-SQMZ)**2+HZ**2)*((SH-SQMZP)**2+HZP**2))
876 IF(MSTP(44).EQ.3.OR.MSTP(44).EQ.5.OR.MSTP(44).EQ.6.OR.
877 & MSTP(44).EQ.7) VINT(116)=XWC**2*SH**2/((SH-SQMZP)**2+HZP**2)
878 ENDIF
879 DO 270 I=1,MDCY(32,3)
880 IDC=I+MDCY(32,2)-1
881 IF(MDME(IDC,1).LT.0) GOTO 270
882 RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH
883 RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH
884 IF(SQRT(RM1)+SQRT(RM2).GT.1..OR.MDME(IDC,1).LT.0) GOTO 270
885 WID2=1.
886 IF(I.LE.16) THEN
887 IF(I.LE.8) THEN
888C...Z'0 -> q + q~
889 EF=KCHG(I,1)/3.
890 AF=SIGN(1.,EF+0.1)
891 VF=AF-4.*EF*XWV
892 VPF=PARU(123-2*MOD(I,2))
893 APF=PARU(124-2*MOD(I,2))
894 FCOF=3.*RADC
895 IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF*PYHFTH(SH,SH*RM1,1.)
896 IF(I.EQ.6.AND.MSTP(48).GE.1) WID2=WIDS(26,1)
897 IF((I.EQ.7.OR.I.EQ.8).AND.MSTP(49).GE.1) WID2=WIDS(20+I,1)
898 ELSEIF(I.LE.16) THEN
899C...Z'0 -> l+ + l-, nu + nu~
900 EF=KCHG(I+2,1)/3.
901 AF=SIGN(1.,EF+0.1)
902 VF=AF-4.*EF*XWV
903 VPF=PARU(127-2*MOD(I,2))
904 APF=PARU(128-2*MOD(I,2))
905 FCOF=1.
906 IF((I.EQ.15.OR.I.EQ.16).AND.MSTP(49).GE.1) WID2=WIDS(14+I,1)
907 ENDIF
908 BE34=SQRT(MAX(0.,1.-4.*RM1))
909 IF(ICASE.EQ.1) THEN
910 WDTPZ=FCOF*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*BE34
911 WDTP(I)=FCOF*(VPF**2*(1.+2.*RM1)+APF**2*(1.-4.*RM1))*BE34
912 ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN
913 WDTP(I)=FCOF*((EI**2*VINT(111)*EF**2+EI*VI*VINT(112)*
914 & EF*VF+EI*VPI*VINT(113)*EF*VPF+(VI**2+AI**2)*VINT(114)*
915 & VF**2+(VI*VPI+AI*API)*VINT(115)*VF*VPF+(VPI**2+API**2)*
916 & VINT(116)*VPF**2)*(1.+2.*RM1)+((VI**2+AI**2)*VINT(114)*
917 & AF**2+(VI*VPI+AI*API)*VINT(115)*AF*APF+(VPI**2+API**2)*
918 & VINT(116)*APF**2)*(1.-4.*RM1))*BE34
919 ELSEIF(MINT(61).EQ.2) THEN
920 FGGF=FCOF*EF**2*(1.+2.*RM1)*BE34
921 FGZF=FCOF*EF*VF*(1.+2.*RM1)*BE34
922 FGZPF=FCOF*EF*VPF*(1.+2.*RM1)*BE34
923 FZZF=FCOF*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*BE34
924 FZZPF=FCOF*(VF*VPF*(1.+2.*RM1)+AF*APF*(1.-4.*RM1))*BE34
925 FZPZPF=FCOF*(VPF**2*(1.+2.*RM1)+APF**2*(1.-4.*RM1))*BE34
926 ENDIF
927 ELSEIF(I.EQ.17) THEN
928C...Z'0 -> W+ + W-
929 WDTPZP=PARU(129)**2*XW1**2*
930 & SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))**3*
931 & (1.+10.*RM1+10.*RM2+RM1**2+RM2**2+10.*RM1*RM2)
932 IF(ICASE.EQ.1) THEN
933 WDTPZ=0.
934 WDTP(I)=WDTPZP
935 ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN
936 WDTP(I)=(VPI**2+API**2)*VINT(116)*WDTPZP
937 ELSEIF(MINT(61).EQ.2) THEN
938 FGGF=0.
939 FGZF=0.
940 FGZPF=0.
941 FZZF=0.
942 FZZPF=0.
943 FZPZPF=WDTPZP
944 ENDIF
945 WID2=WIDS(24,1)
946 ELSEIF(I.EQ.18) THEN
947C...Z'0 -> H+ + H-
948 CZC=2.*(1.-2.*XW)
949 BE34C=(1.-4.*RM1)*SQRT(MAX(0.,1.-4.*RM1))
950 IF(ICASE.EQ.1) THEN
951 WDTPZ=0.25*PARU(142)**2*CZC**2*BE34C
952 WDTP(I)=0.25*PARU(143)**2*CZC**2*BE34C
953 ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN
954 WDTP(I)=0.25*(EI**2*VINT(111)+PARU(142)*EI*VI*VINT(112)*
955 & CZC+PARU(143)*EI*VPI*VINT(113)*CZC+PARU(142)**2*
956 & (VI**2+AI**2)*VINT(114)*CZC**2+PARU(142)*PARU(143)*
957 & (VI*VPI+AI*API)*VINT(115)*CZC**2+PARU(143)**2*
958 & (VPI**2+API**2)*VINT(116)*CZC**2)*BE34C
959 ELSEIF(MINT(61).EQ.2) THEN
960 FGGF=0.25*BE34C
961 FGZF=0.25*PARU(142)*CZC*BE34C
962 FGZPF=0.25*PARU(143)*CZC*BE34C
963 FZZF=0.25*PARU(142)**2*CZC**2*BE34C
964 FZZPF=0.25*PARU(142)*PARU(143)*CZC**2*BE34C
965 FZPZPF=0.25*PARU(143)**2*CZC**2*BE34C
966 ENDIF
967 WID2=WIDS(37,1)
968 ELSEIF(I.EQ.19) THEN
969C...Z'0 -> Z0 + gamma.
970 ELSEIF(I.EQ.20) THEN
971C...Z'0 -> Z0 + H0
972 FLAM=SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))
973 WDTPZP=PARU(145)**2*4.*ABS(1.-2.*XW)*(3.*RM1+0.25*FLAM**2)*
974 & FLAM
975 IF(ICASE.EQ.1) THEN
976 WDTPZ=0.
977 WDTP(I)=WDTPZP
978 ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN
979 WDTP(I)=(VPI**2+API**2)*VINT(116)*WDTPZP
980 ELSEIF(MINT(61).EQ.2) THEN
981 FGGF=0.
982 FGZF=0.
983 FGZPF=0.
984 FZZF=0.
985 FZZPF=0.
986 FZPZPF=WDTPZP
987 ENDIF
988 WID2=WIDS(23,2)*WIDS(25,2)
989 ELSEIF(I.EQ.21.OR.I.EQ.22) THEN
990C...Z' -> H0 + A0 or H'0 + A0.
991 BE34C=SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))**3
992 IF(I.EQ.21) THEN
993 CZAH=PARU(186)
994 CZPAH=PARU(188)
995 ELSE
996 CZAH=PARU(187)
997 CZPAH=PARU(189)
998 ENDIF
999 IF(ICASE.EQ.1) THEN
1000 WDTPZ=CZAH**2*BE34C
1001 WDTP(I)=CZPAH**2*BE34C
1002 ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN
1003 WDTP(I)=(CZAH**2*(VI**2+AI**2)*VINT(114)+CZAH*CZPAH*
1004 & (VI*VPI+AI*API)*VINT(115)+CZPAH**2*(VPI**2+API**2)*
1005 & VINT(116))*BE34C
1006 ELSEIF(MINT(61).EQ.2) THEN
1007 FGGF=0.
1008 FGZF=0.
1009 FGZPF=0.
1010 FZZF=CZAH**2*BE34C
1011 FZZPF=CZAH*CZPAH*BE34C
1012 FZPZPF=CZPAH**2*BE34C
1013 ENDIF
1014 IF(I.EQ.21) WID2=WIDS(25,2)*WIDS(36,2)
1015 IF(I.EQ.22) WID2=WIDS(35,2)*WIDS(36,2)
1016 ENDIF
1017 IF(ICASE.EQ.1) THEN
1018 VINT(117)=VINT(117)+WDTPZ
1019 WDTP(0)=WDTP(0)+WDTP(I)
1020 ENDIF
1021 IF(MDME(IDC,1).GT.0) THEN
1022 IF((ICASE.EQ.1.AND.MINT(61).NE.1).OR.
1023 & (ICASE.EQ.2.AND.MINT(61).EQ.1)) THEN
1024 WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
1025 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
1026 WDTE(I,0)=WDTE(I,MDME(IDC,1))
1027 WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
1028 ENDIF
1029 IF(MINT(61).EQ.2.AND.ICASE.EQ.2) THEN
1030 IF(MSTP(44).EQ.1.OR.MSTP(44).EQ.4.OR.MSTP(44).EQ.5.OR.
1031 & MSTP(44).EQ.7) VINT(111)=VINT(111)+FGGF*WID2
1032 IF(MSTP(44).EQ.4.OR.MSTP(44).EQ.7) VINT(112)=VINT(112)+
1033 & FGZF*WID2
1034 IF(MSTP(44).EQ.5.OR.MSTP(44).EQ.7) VINT(113)=VINT(113)+
1035 & FGZPF*WID2
1036 IF(MSTP(44).EQ.2.OR.MSTP(44).EQ.4.OR.MSTP(44).EQ.6.OR.
1037 & MSTP(44).EQ.7) VINT(114)=VINT(114)+FZZF*WID2
1038 IF(MSTP(44).EQ.6.OR.MSTP(44).EQ.7) VINT(115)=VINT(115)+
1039 & FZZPF*WID2
1040 IF(MSTP(44).EQ.3.OR.MSTP(44).EQ.5.OR.MSTP(44).EQ.6.OR.
1041 & MSTP(44).EQ.7) VINT(116)=VINT(116)+FZPZPF*WID2
1042 ENDIF
1043 ENDIF
1044 270 CONTINUE
1045 IF(MINT(61).GE.1) ICASE=3-ICASE
1046 IF(ICASE.EQ.2) GOTO 260
1047
1048 ELSEIF(KFLA.EQ.34) THEN
1049C...W'+/-:
1050 DO 280 I=1,MDCY(34,3)
1051 IDC=I+MDCY(34,2)-1
1052 IF(MDME(IDC,1).LT.0) GOTO 280
1053 RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH
1054 RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH
1055 IF(SQRT(RM1)+SQRT(RM2).GT.1.) GOTO 280
1056 WID2=1.
1057 IF(I.LE.20) THEN
1058 IF(I.LE.16) THEN
1059C...W'+/- -> q + q~'
1060 FCOF=3.*RADC*(PARU(131)**2+PARU(132)**2)*
1061 & VCKM((I-1)/4+1,MOD(I-1,4)+1)
1062 IF(KFLR.GT.0) THEN
1063 IF(MOD(I,4).EQ.3.AND.MSTP(48).GE.1) WID2=WIDS(26,2)
1064 IF(MOD(I,4).EQ.0.AND.MSTP(49).GE.1) WID2=WIDS(28,2)
1065 IF(I.GE.13.AND.MSTP(49).GE.1) WID2=WID2*WIDS(27,3)
1066 ELSE
1067 IF(MOD(I,4).EQ.3.AND.MSTP(48).GE.1) WID2=WIDS(26,3)
1068 IF(MOD(I,4).EQ.0.AND.MSTP(49).GE.1) WID2=WIDS(28,3)
1069 IF(I.GE.13.AND.MSTP(49).GE.1) WID2=WID2*WIDS(27,2)
1070 ENDIF
1071 ELSEIF(I.LE.20) THEN
1072C...W'+/- -> l+/- + nu
1073 FCOF=PARU(133)**2+PARU(134)**2
1074 IF(KFLR.GT.0) THEN
1075 IF(I.EQ.20.AND.MSTP(49).GE.1) WID2=WIDS(29,3)*WIDS(30,2)
1076 ELSE
1077 IF(I.EQ.20.AND.MSTP(49).GE.1) WID2=WIDS(29,2)*WIDS(30,3)
1078 ENDIF
1079 ENDIF
1080 WDTP(I)=FCOF*0.5*(2.-RM1-RM2-(RM1-RM2)**2)*
1081 & SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))
1082 ELSEIF(I.EQ.21) THEN
1083C...W'+/- -> W+/- + Z0
1084 WDTP(I)=PARU(135)**2*0.5*XW1*(RM1/RM2)*
1085 & SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))**3*
1086 & (1.+10.*RM1+10.*RM2+RM1**2+RM2**2+10.*RM1*RM2)
1087 IF(KFLR.GT.0) WID2=WIDS(24,2)*WIDS(23,2)
1088 IF(KFLR.LT.0) WID2=WIDS(24,3)*WIDS(23,2)
1089 ELSEIF(I.EQ.23) THEN
1090C...W'+/- -> W+/- + H0
1091 FLAM=SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))
1092 WDTP(I)=PARU(146)**2*2.*(3.*RM1+0.25*FLAM**2)*FLAM
1093 IF(KFLR.GT.0) WID2=WIDS(24,2)*WIDS(25,2)
1094 IF(KFLR.LT.0) WID2=WIDS(24,3)*WIDS(25,2)
1095 ENDIF
1096 WDTP(0)=WDTP(0)+WDTP(I)
1097 IF(MDME(IDC,1).GT.0) THEN
1098 WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
1099 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
1100 WDTE(I,0)=WDTE(I,MDME(IDC,1))
1101 WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
1102 ENDIF
1103 280 CONTINUE
1104
1105 ELSEIF(KFLA.EQ.37) THEN
1106C...H+/-:
1107 DO 290 I=1,MDCY(37,3)
1108 IDC=I+MDCY(37,2)-1
1109 IF(MDME(IDC,1).LT.0) GOTO 290
1110 RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH
1111 RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH
1112 IF(SQRT(RM1)+SQRT(RM2).GT.1.) GOTO 290
1113 WID2=1.
1114 IF(I.LE.4) THEN
1115C...H+/- -> q + q~'
1116 RM1R=RM1
1117 IF(MSTP(37).EQ.1.AND.MSTP(2).GE.1) RM1R=RM1*
1118 & (LOG(MAX(4.,PARP(37)**2*RM1*SH/PARU(117)**2))/
1119 & LOG(MAX(4.,SH/PARU(117)**2)))**(24./(33.-2.*MSTU(118)))
1120 WDTP(I)=3.*RADC*((RM1R*PARU(141)**2+RM2/PARU(141)**2)*
1121 & (1.-RM1R-RM2)-4.*RM1R*RM2)*
1122 & SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))
1123 IF(KFLR.GT.0) THEN
1124 IF(I.EQ.3.AND.MSTP(48).GE.1) WID2=WIDS(26,2)
1125 IF(I.EQ.4.AND.MSTP(49).GE.1) WID2=WIDS(27,3)*WIDS(28,2)
1126 ELSE
1127 IF(I.EQ.3.AND.MSTP(48).GE.1) WID2=WIDS(26,3)
1128 IF(I.EQ.4.AND.MSTP(49).GE.1) WID2=WIDS(27,2)*WIDS(28,3)
1129 ENDIF
1130 ELSEIF(I.LE.8) THEN
1131C...H+/- -> l+/- + nu
1132 WDTP(I)=((RM1*PARU(141)**2+RM2/PARU(141)**2)*(1.-RM1-RM2)-
1133 & 4.*RM1*RM2)*SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))
1134 IF(KFLR.GT.0) THEN
1135 IF(I.EQ.8.AND.MSTP(49).GE.1) WID2=WIDS(29,3)*WIDS(30,2)
1136 ELSE
1137 IF(I.EQ.8.AND.MSTP(49).GE.1) WID2=WIDS(29,2)*WIDS(30,3)
1138 ENDIF
1139 ELSEIF(I.EQ.9) THEN
1140C...H+/- -> W+/- + H0.
1141 WDTP(I)=PARU(195)**2*0.5*SQRT(MAX(0.,(1.-RM1-RM2)**2-
1142 & 4.*RM1*RM2))**3
1143 IF(KFLR.GT.0) WID2=WIDS(24,2)*WIDS(25,2)
1144 IF(KFLR.LT.0) WID2=WIDS(24,3)*WIDS(25,2)
1145 ENDIF
1146 WDTP(0)=WDTP(0)+WDTP(I)
1147 IF(MDME(IDC,1).GT.0) THEN
1148 WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
1149 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
1150 WDTE(I,0)=WDTE(I,MDME(IDC,1))
1151 WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
1152 ENDIF
1153 290 CONTINUE
1154
1155 ELSEIF(KFLA.EQ.38) THEN
1156C...Techni-eta.
1157 DO 300 I=1,MDCY(38,3)
1158 IDC=I+MDCY(38,2)-1
1159 IF(MDME(IDC,1).LT.0) GOTO 300
1160 RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH
1161 RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH
1162 IF(SQRT(RM1)+SQRT(RM2).GT.1.) GOTO 300
1163 WID2=1.
1164 IF(I.LE.2) THEN
1165 WDTP(I)=RM1*SH*SQRT(MAX(0.,1.-4.*RM1))/
1166 & (4.*PARU(1)*PARP(46)**2)
1167 IF(I.EQ.2.AND.MSTP(48).GE.1) WID2=WIDS(26,1)
1168 ELSE
1169 WDTP(I)=5.*AS**2*SH/(96.*PARU(1)**3*PARP(46)**2)
1170 ENDIF
1171 WDTP(0)=WDTP(0)+WDTP(I)
1172 IF(MDME(IDC,1).GT.0) THEN
1173 WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
1174 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
1175 WDTE(I,0)=WDTE(I,MDME(IDC,1))
1176 WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
1177 ENDIF
1178 300 CONTINUE
1179
1180 ELSEIF(KFLA.EQ.39) THEN
1181C...LQ (leptoquark).
1182 DO 310 I=1,MDCY(39,3)
1183 IDC=I+MDCY(39,2)-1
1184 IF(MDME(IDC,1).LT.0) GOTO 310
1185 RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH
1186 RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH
1187 IF(SQRT(RM1)+SQRT(RM2).GT.1.) GOTO 310
1188 WDTP(I)=PARU(151)*SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))**3
1189 WID2=1.
1190 WDTP(0)=WDTP(0)+WDTP(I)
1191 IF(MDME(IDC,1).GT.0) THEN
1192 WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
1193 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
1194 WDTE(I,0)=WDTE(I,MDME(IDC,1))
1195 WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
1196 ENDIF
1197 310 CONTINUE
1198
1199 ELSEIF(KFLA.EQ.40) THEN
1200C...R:
1201 DO 320 I=1,MDCY(40,3)
1202 IDC=I+MDCY(40,2)-1
1203 IF(MDME(IDC,1).LT.0) GOTO 320
1204 RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH
1205 RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH
1206 IF(SQRT(RM1)+SQRT(RM2).GT.1.) GOTO 320
1207 WID2=1.
1208 IF(I.LE.6) THEN
1209C...R -> q + q~'
1210 FCOF=3.*RADC
1211 ELSEIF(I.LE.9) THEN
1212C...R -> l+ + l'-
1213 FCOF=1.
1214 ENDIF
1215 WDTP(I)=FCOF*(2.-RM1-RM2-(RM1-RM2)**2)*
1216 & SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))
1217 IF(KFLR.GT.0) THEN
1218 IF(I.EQ.4.AND.MSTP(48).GE.1) WID2=WIDS(26,3)
1219 IF(I.EQ.5.AND.MSTP(49).GE.1) WID2=WIDS(27,3)
1220 IF(I.EQ.6.AND.MSTP(49).GE.1) WID2=WIDS(26,2)*WIDS(28,3)
1221 IF(I.EQ.9.AND.MSTP(49).GE.1) WID2=WIDS(29,3)
1222 ELSE
1223 IF(I.EQ.4.AND.MSTP(48).GE.1) WID2=WIDS(26,2)
1224 IF(I.EQ.5.AND.MSTP(49).GE.1) WID2=WIDS(27,2)
1225 IF(I.EQ.6.AND.MSTP(49).GE.1) WID2=WIDS(26,3)*WIDS(28,2)
1226 IF(I.EQ.9.AND.MSTP(49).GE.1) WID2=WIDS(29,2)
1227 ENDIF
1228 WDTP(0)=WDTP(0)+WDTP(I)
1229 IF(MDME(IDC,1).GT.0) THEN
1230 WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
1231 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
1232 WDTE(I,0)=WDTE(I,MDME(IDC,1))
1233 WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
1234 ENDIF
1235 320 CONTINUE
1236
1237 ENDIF
1238 MINT(61)=0
1239 MINT(62)=0
1240
1241 RETURN
1242 END