Analysis Software
Documentation for sPHENIX simulation software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
pyhiwidt.f
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file pyhiwidt.f
1 
2 C*********************************************************************
3 
4  SUBROUTINE pyhiwidt(KFLR,RMAS,WDTP,WDTE)
5 
6 C...Calculates full and partial widths of resonances.
7  common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
8  SAVE /ludat1/
9  common/ludat2/kchg(500,3),pmas(500,4),parf(2000),vckm(4,4)
10  SAVE /ludat2/
11  common/ludat3/mdcy(500,3),mdme(2000,2),brat(2000),kfdp(2000,5)
12  SAVE /ludat3/
13  common/pyhipars/mstp(200),parp(200),msti(200),pari(200)
14  SAVE /pyhipars/
15  common/pyhiint1/mint(400),vint(400)
16  SAVE /pyhiint1/
17  common/pyhiint4/widp(21:40,0:40),wide(21:40,0:40),wids(21:40,3)
18  SAVE /pyhiint4/
19  dimension wdtp(0:40),wdte(0:40,0:5)
20 
21 C...Some common constants.
22  kfla=iabs(kflr)
23  sqm=rmas**2
24  as=ulalps(sqm)
25  aem=paru(101)
26  xw=paru(102)
27  radc=1.+as/paru(1)
28 
29 C...Reset width information.
30  DO 100 i=0,40
31  wdtp(i)=0.
32  DO 100 j=0,5
33  100 wdte(i,j)=0.
34 
35  IF(kfla.EQ.21) THEN
36 C...QCD:
37  DO 110 i=1,mdcy(21,3)
38  idc=i+mdcy(21,2)-1
39  rm1=(pmas(iabs(kfdp(idc,1)),1)/rmas)**2
40  rm2=(pmas(iabs(kfdp(idc,2)),1)/rmas)**2
41  IF(sqrt(rm1)+sqrt(rm2).GT.1..OR.mdme(idc,1).LT.0) goto 110
42  IF(i.LE.8) THEN
43 C...QCD -> q + qb
44  wdtp(i)=(1.+2.*rm1)*sqrt(max(0.,1.-4.*rm1))
45  wid2=1.
46  ENDIF
47  wdtp(0)=wdtp(0)+wdtp(i)
48  IF(mdme(idc,1).GT.0) THEN
49  wdte(i,mdme(idc,1))=wdtp(i)*wid2
50  wdte(0,mdme(idc,1))=wdte(0,mdme(idc,1))+wdte(i,mdme(idc,1))
51  wdte(i,0)=wdte(i,mdme(idc,1))
52  wdte(0,0)=wdte(0,0)+wdte(i,0)
53  ENDIF
54  110 CONTINUE
55 
56  ELSEIF(kfla.EQ.23) THEN
57 C...Z0:
58  IF(mint(61).EQ.1) THEN
59  ei=kchg(iabs(mint(15)),1)/3.
60  ai=sign(1.,ei)
61  vi=ai-4.*ei*xw
62  sqmz=pmas(23,1)**2
63  gzmz=pmas(23,2)*pmas(23,1)
64  ggi=ei**2
65  gzi=ei*vi/(8.*xw*(1.-xw))*sqm*(sqm-sqmz)/
66  & ((sqm-sqmz)**2+gzmz**2)
67  zzi=(vi**2+ai**2)/(16.*xw*(1.-xw))**2*sqm**2/
68  & ((sqm-sqmz)**2+gzmz**2)
69  IF(mstp(43).EQ.1) THEN
70 C...Only gamma* production included
71  gzi=0.
72  zzi=0.
73  ELSEIF(mstp(43).EQ.2) THEN
74 C...Only Z0 production included
75  ggi=0.
76  gzi=0.
77  ENDIF
78  ELSEIF(mint(61).EQ.2) THEN
79  vint(111)=0.
80  vint(112)=0.
81  vint(114)=0.
82  ENDIF
83  DO 120 i=1,mdcy(23,3)
84  idc=i+mdcy(23,2)-1
85  rm1=(pmas(iabs(kfdp(idc,1)),1)/rmas)**2
86  rm2=(pmas(iabs(kfdp(idc,2)),1)/rmas)**2
87  IF(sqrt(rm1)+sqrt(rm2).GT.1..OR.mdme(idc,1).LT.0) goto 120
88  IF(i.LE.8) THEN
89 C...Z0 -> q + qb
90  ef=kchg(i,1)/3.
91  af=sign(1.,ef+0.1)
92  vf=af-4.*ef*xw
93  IF(mint(61).EQ.0) THEN
94  wdtp(i)=3.*(vf**2*(1.+2.*rm1)+af**2*(1.-4.*rm1))*
95  & sqrt(max(0.,1.-4.*rm1))*radc
96  ELSEIF(mint(61).EQ.1) THEN
97  wdtp(i)=3.*((ggi*ef**2+gzi*ef*vf+zzi*vf**2)*
98  & (1.+2.*rm1)+zzi*af**2*(1.-4.*rm1))*
99  & sqrt(max(0.,1.-4.*rm1))*radc
100  ELSEIF(mint(61).EQ.2) THEN
101  ggf=3.*ef**2*(1.+2.*rm1)*sqrt(max(0.,1.-4.*rm1))*radc
102  gzf=3.*ef*vf*(1.+2.*rm1)*sqrt(max(0.,1.-4.*rm1))*radc
103  zzf=3.*(vf**2*(1.+2.*rm1)+af**2*(1.-4.*rm1))*
104  & sqrt(max(0.,1.-4.*rm1))*radc
105  ENDIF
106  wid2=1.
107  ELSEIF(i.LE.16) THEN
108 C...Z0 -> l+ + l-, nu + nub
109  ef=kchg(i+2,1)/3.
110  af=sign(1.,ef+0.1)
111  vf=af-4.*ef*xw
112  wdtp(i)=(vf**2*(1.+2.*rm1)+af**2*(1.-4.*rm1))*
113  & sqrt(max(0.,1.-4.*rm1))
114  IF(mint(61).EQ.0) THEN
115  wdtp(i)=(vf**2*(1.+2.*rm1)+af**2*(1.-4.*rm1))*
116  & sqrt(max(0.,1.-4.*rm1))
117  ELSEIF(mint(61).EQ.1) THEN
118  wdtp(i)=((ggi*ef**2+gzi*ef*vf+zzi*vf**2)*
119  & (1.+2.*rm1)+zzi*af**2*(1.-4.*rm1))*
120  & sqrt(max(0.,1.-4.*rm1))
121  ELSEIF(mint(61).EQ.2) THEN
122  ggf=ef**2*(1.+2.*rm1)*sqrt(max(0.,1.-4.*rm1))
123  gzf=ef*vf*(1.+2.*rm1)*sqrt(max(0.,1.-4.*rm1))
124  zzf=(vf**2*(1.+2.*rm1)+af**2*(1.-4.*rm1))*
125  & sqrt(max(0.,1.-4.*rm1))
126  ENDIF
127  wid2=1.
128  ELSE
129 C...Z0 -> H+ + H-
130  cf=2.*(1.-2.*xw)
131  IF(mint(61).EQ.0) THEN
132  wdtp(i)=0.25*cf**2*(1.-4.*rm1)*sqrt(max(0.,1.-4.*rm1))
133  ELSEIF(mint(61).EQ.1) THEN
134  wdtp(i)=0.25*(ggi+gzi*cf+zzi*cf**2)*(1.-4.*rm1)*
135  & sqrt(max(0.,1.-4.*rm1))
136  ELSEIF(mint(61).EQ.2) THEN
137  ggf=0.25*(1.-4.*rm1)*sqrt(max(0.,1.-4.*rm1))
138  gzf=0.25*cf*(1.-4.*rm1)*sqrt(max(0.,1.-4.*rm1))
139  zzf=0.25*cf**2*(1.-4.*rm1)*sqrt(max(0.,1.-4.*rm1))
140  ENDIF
141  wid2=wids(37,1)
142  ENDIF
143  wdtp(0)=wdtp(0)+wdtp(i)
144  IF(mdme(idc,1).GT.0) THEN
145  wdte(i,mdme(idc,1))=wdtp(i)*wid2
146  wdte(0,mdme(idc,1))=wdte(0,mdme(idc,1))+wdte(i,mdme(idc,1))
147  wdte(i,0)=wdte(i,mdme(idc,1))
148  wdte(0,0)=wdte(0,0)+wdte(i,0)
149  vint(111)=vint(111)+ggf*wid2
150  vint(112)=vint(112)+gzf*wid2
151  vint(114)=vint(114)+zzf*wid2
152  ENDIF
153  120 CONTINUE
154  IF(mstp(43).EQ.1) THEN
155 C...Only gamma* production included
156  vint(112)=0.
157  vint(114)=0.
158  ELSEIF(mstp(43).EQ.2) THEN
159 C...Only Z0 production included
160  vint(111)=0.
161  vint(112)=0.
162  ENDIF
163 
164  ELSEIF(kfla.EQ.24) THEN
165 C...W+/-:
166  DO 130 i=1,mdcy(24,3)
167  idc=i+mdcy(24,2)-1
168  rm1=(pmas(iabs(kfdp(idc,1)),1)/rmas)**2
169  rm2=(pmas(iabs(kfdp(idc,2)),1)/rmas)**2
170  IF(sqrt(rm1)+sqrt(rm2).GT.1..OR.mdme(idc,1).LT.0) goto 130
171  IF(i.LE.16) THEN
172 C...W+/- -> q + qb'
173  wdtp(i)=3.*(2.-rm1-rm2-(rm1-rm2)**2)*
174  & sqrt(max(0.,(1.-rm1-rm2)**2-4.*rm1*rm2))*
175  & vckm((i-1)/4+1,mod(i-1,4)+1)*radc
176  wid2=1.
177  ELSE
178 C...W+/- -> l+/- + nu
179  wdtp(i)=(2.-rm1-rm2-(rm1-rm2)**2)*
180  & sqrt(max(0.,(1.-rm1-rm2)**2-4.*rm1*rm2))
181  wid2=1.
182  ENDIF
183  wdtp(0)=wdtp(0)+wdtp(i)
184  IF(mdme(idc,1).GT.0) THEN
185  wdte(i,mdme(idc,1))=wdtp(i)*wid2
186  wdte(0,mdme(idc,1))=wdte(0,mdme(idc,1))+wdte(i,mdme(idc,1))
187  wdte(i,0)=wdte(i,mdme(idc,1))
188  wdte(0,0)=wdte(0,0)+wdte(i,0)
189  ENDIF
190  130 CONTINUE
191 
192  ELSEIF(kfla.EQ.25) THEN
193 C...H0:
194  DO 170 i=1,mdcy(25,3)
195  idc=i+mdcy(25,2)-1
196  rm1=(pmas(iabs(kfdp(idc,1)),1)/rmas)**2
197  rm2=(pmas(iabs(kfdp(idc,2)),1)/rmas)**2
198  IF(sqrt(rm1)+sqrt(rm2).GT.1..OR.mdme(idc,1).LT.0) goto 170
199  IF(i.LE.8) THEN
200 C...H0 -> q + qb
201  wdtp(i)=3.*rm1*(1.-4.*rm1)*sqrt(max(0.,1.-4.*rm1))*radc
202  wid2=1.
203  ELSEIF(i.LE.12) THEN
204 C...H0 -> l+ + l-
205  wdtp(i)=rm1*(1.-4.*rm1)*sqrt(max(0.,1.-4.*rm1))
206  wid2=1.
207  ELSEIF(i.EQ.13) THEN
208 C...H0 -> g + g; quark loop contribution only
209  etare=0.
210  etaim=0.
211  DO 140 j=1,2*mstp(1)
212  eps=(2.*pmas(j,1)/rmas)**2
213  IF(eps.LE.1.) THEN
214  IF(eps.GT.1.e-4) THEN
215  root=sqrt(1.-eps)
216  rln=log((1.+root)/(1.-root))
217  ELSE
218  rln=log(4./eps-2.)
219  ENDIF
220  phire=0.25*(rln**2-paru(1)**2)
221  phiim=0.5*paru(1)*rln
222  ELSE
223  phire=-(asin(1./sqrt(eps)))**2
224  phiim=0.
225  ENDIF
226  etare=etare+0.5*eps*(1.+(eps-1.)*phire)
227  etaim=etaim+0.5*eps*(eps-1.)*phiim
228  140 CONTINUE
229  eta2=etare**2+etaim**2
230  wdtp(i)=(as/paru(1))**2*eta2
231  wid2=1.
232  ELSEIF(i.EQ.14) THEN
233 C...H0 -> gamma + gamma; quark, charged lepton and W loop contributions
234  etare=0.
235  etaim=0.
236  DO 150 j=1,3*mstp(1)+1
237  IF(j.LE.2*mstp(1)) THEN
238  ej=kchg(j,1)/3.
239  eps=(2.*pmas(j,1)/rmas)**2
240  ELSEIF(j.LE.3*mstp(1)) THEN
241  jl=2*(j-2*mstp(1))-1
242  ej=kchg(10+jl,1)/3.
243  eps=(2.*pmas(10+jl,1)/rmas)**2
244  ELSE
245  eps=(2.*pmas(24,1)/rmas)**2
246  ENDIF
247  IF(eps.LE.1.) THEN
248  IF(eps.GT.1.e-4) THEN
249  root=sqrt(1.-eps)
250  rln=log((1.+root)/(1.-root))
251  ELSE
252  rln=log(4./eps-2.)
253  ENDIF
254  phire=0.25*(rln**2-paru(1)**2)
255  phiim=0.5*paru(1)*rln
256  ELSE
257  phire=-(asin(1./sqrt(eps)))**2
258  phiim=0.
259  ENDIF
260  IF(j.LE.2*mstp(1)) THEN
261  etare=etare+0.5*3.*ej**2*eps*(1.+(eps-1.)*phire)
262  etaim=etaim+0.5*3.*ej**2*eps*(eps-1.)*phiim
263  ELSEIF(j.LE.3*mstp(1)) THEN
264  etare=etare+0.5*ej**2*eps*(1.+(eps-1.)*phire)
265  etaim=etaim+0.5*ej**2*eps*(eps-1.)*phiim
266  ELSE
267  etare=etare-0.5-0.75*eps*(1.+(eps-2.)*phire)
268  etaim=etaim+0.75*eps*(eps-2.)*phiim
269  ENDIF
270  150 CONTINUE
271  eta2=etare**2+etaim**2
272  wdtp(i)=(aem/paru(1))**2*0.5*eta2
273  wid2=1.
274  ELSEIF(i.EQ.15) THEN
275 C...H0 -> gamma + Z0; quark, charged lepton and W loop contributions
276  etare=0.
277  etaim=0.
278  DO 160 j=1,3*mstp(1)+1
279  IF(j.LE.2*mstp(1)) THEN
280  ej=kchg(j,1)/3.
281  aj=sign(1.,ej+0.1)
282  vj=aj-4.*ej*xw
283  eps=(2.*pmas(j,1)/rmas)**2
284  epsp=(2.*pmas(j,1)/pmas(23,1))**2
285  ELSEIF(j.LE.3*mstp(1)) THEN
286  jl=2*(j-2*mstp(1))-1
287  ej=kchg(10+jl,1)/3.
288  aj=sign(1.,ej+0.1)
289  vj=ai-4.*ej*xw
290  eps=(2.*pmas(10+jl,1)/rmas)**2
291  epsp=(2.*pmas(10+jl,1)/pmas(23,1))**2
292  ELSE
293  eps=(2.*pmas(24,1)/rmas)**2
294  epsp=(2.*pmas(24,1)/pmas(23,1))**2
295  ENDIF
296  IF(eps.LE.1.) THEN
297  root=sqrt(1.-eps)
298  IF(eps.GT.1.e-4) THEN
299  rln=log((1.+root)/(1.-root))
300  ELSE
301  rln=log(4./eps-2.)
302  ENDIF
303  phire=0.25*(rln**2-paru(1)**2)
304  phiim=0.5*paru(1)*rln
305  psire=-(1.+0.5*root*rln)
306  psiim=0.5*paru(1)*root
307  ELSE
308  phire=-(asin(1./sqrt(eps)))**2
309  phiim=0.
310  psire=-(1.+sqrt(eps-1.)*asin(1./sqrt(eps)))
311  psiim=0.
312  ENDIF
313  IF(epsp.LE.1.) THEN
314  root=sqrt(1.-epsp)
315  IF(epsp.GT.1.e-4) THEN
316  rln=log((1.+root)/(1.-root))
317  ELSE
318  rln=log(4./epsp-2.)
319  ENDIF
320  phirep=0.25*(rln**2-paru(1)**2)
321  phiimp=0.5*paru(1)*rln
322  psirep=-(1.+0.5*root*rln)
323  psiimp=0.5*paru(1)*root
324  ELSE
325  phirep=-(asin(1./sqrt(epsp)))**2
326  phiimp=0.
327  psirep=-(1.+sqrt(epsp-1.)*asin(1./sqrt(epsp)))
328  psiimp=0.
329  ENDIF
330  fxyre=eps*epsp/(8.*(eps-epsp))*(1.-eps*epsp/(eps-epsp)*(phire-
331  & phirep)+2.*eps/(eps-epsp)*(psire-psirep))
332  fxyim=eps*epsp/(8.*(eps-epsp))*(-eps*epsp/(eps-epsp)*(phiim-
333  & phiimp)+2.*eps/(eps-epsp)*(psiim-psiimp))
334  f1re=eps*epsp/(2.*(eps-epsp))*(phire-phirep)
335  f1im=eps*epsp/(2.*(eps-epsp))*(phiim-phiimp)
336  IF(j.LE.2*mstp(1)) THEN
337  etare=etare-3.*ej*vj*(fxyre-0.25*f1re)
338  etaim=etaim-3.*ej*vj*(fxyim-0.25*f1im)
339  ELSEIF(j.LE.3*mstp(1)) THEN
340  etare=etare-ej*vj*(fxyre-0.25*f1re)
341  etaim=etaim-ej*vj*(fxyim-0.25*f1im)
342  ELSE
343  etare=etare-sqrt(1.-xw)*(((1.+2./eps)*xw/sqrt(1.-xw)-
344  & (5.+2./eps))*fxyre+(3.-xw/sqrt(1.-xw))*f1re)
345  etaim=etaim-sqrt(1.-xw)*(((1.+2./eps)*xw/sqrt(1.-xw)-
346  & (5.+2./eps))*fxyim+(3.-xw/sqrt(1.-xw))*f1im)
347  ENDIF
348  160 CONTINUE
349  eta2=etare**2+etaim**2
350  wdtp(i)=(aem/paru(1))**2*(1.-(pmas(23,1)/rmas)**2)**3/xw*eta2
351  wid2=wids(23,2)
352  ELSE
353 C...H0 -> Z0 + Z0, W+ + W-
354  wdtp(i)=(1.-4.*rm1+12.*rm1**2)*sqrt(max(0.,1.-4.*rm1))/
355  & (2.*(18-i))
356  wid2=wids(7+i,1)
357  ENDIF
358  wdtp(0)=wdtp(0)+wdtp(i)
359  IF(mdme(idc,1).GT.0) THEN
360  wdte(i,mdme(idc,1))=wdtp(i)*wid2
361  wdte(0,mdme(idc,1))=wdte(0,mdme(idc,1))+wdte(i,mdme(idc,1))
362  wdte(i,0)=wdte(i,mdme(idc,1))
363  wdte(0,0)=wdte(0,0)+wdte(i,0)
364  ENDIF
365  170 CONTINUE
366 
367  ELSEIF(kfla.EQ.32) THEN
368 C...Z'0:
369  IF(mint(61).EQ.1) THEN
370  ei=kchg(iabs(mint(15)),1)/3.
371  ai=sign(1.,ei)
372  vi=ai-4.*ei*xw
373  sqmz=pmas(23,1)**2
374  gzmz=pmas(23,2)*pmas(23,1)
375  api=sign(1.,ei)
376  vpi=api-4.*ei*xw
377  sqmzp=pmas(32,1)**2
378  gzpmzp=pmas(32,2)*pmas(32,1)
379  ggi=ei**2
380  gzi=ei*vi/(8.*xw*(1.-xw))*sqm*(sqm-sqmz)/
381  & ((sqm-sqmz)**2+gzmz**2)
382  gzpi=ei*vpi/(8.*xw*(1.-xw))*sqm*(sqm-sqmzp)/
383  & ((sqm-sqmzp)**2+gzpmzp**2)
384  zzi=(vi**2+ai**2)/(16.*xw*(1.-xw))**2*sqm**2/
385  & ((sqm-sqmz)**2+gzmz**2)
386  zzpi=2.*(vi*vpi+ai*api)/(16.*xw*(1.-xw))**2*
387  & sqm**2*((sqm-sqmz)*(sqm-sqmzp)+gzmz*gzpmzp)/
388  & (((sqm-sqmz)**2+gzmz**2)*((sqm-sqmzp)**2+gzpmzp**2))
389  zpzpi=(vpi**2+api**2)/(16.*xw*(1.-xw))**2*sqm**2/
390  & ((sqm-sqmzp)**2+gzpmzp**2)
391  IF(mstp(44).EQ.1) THEN
392 C...Only gamma* production included
393  gzi=0.
394  gzpi=0.
395  zzi=0.
396  zzpi=0.
397  zpzpi=0.
398  ELSEIF(mstp(44).EQ.2) THEN
399 C...Only Z0 production included
400  ggi=0.
401  gzi=0.
402  gzpi=0.
403  zzpi=0.
404  zpzpi=0.
405  ELSEIF(mstp(44).EQ.3) THEN
406 C...Only Z'0 production included
407  ggi=0.
408  gzi=0.
409  gzpi=0.
410  zzi=0.
411  zzpi=0.
412  ELSEIF(mstp(44).EQ.4) THEN
413 C...Only gamma*/Z0 production included
414  gzpi=0.
415  zzpi=0.
416  zpzpi=0.
417  ELSEIF(mstp(44).EQ.5) THEN
418 C...Only gamma*/Z'0 production included
419  gzi=0.
420  zzi=0.
421  zzpi=0.
422  ELSEIF(mstp(44).EQ.6) THEN
423 C...Only Z0/Z'0 production included
424  ggi=0.
425  gzi=0.
426  gzpi=0.
427  ENDIF
428  ELSEIF(mint(61).EQ.2) THEN
429  vint(111)=0.
430  vint(112)=0.
431  vint(113)=0.
432  vint(114)=0.
433  vint(115)=0.
434  vint(116)=0.
435  ENDIF
436  DO 180 i=1,mdcy(32,3)
437  idc=i+mdcy(32,2)-1
438  rm1=(pmas(iabs(kfdp(idc,1)),1)/rmas)**2
439  rm2=(pmas(iabs(kfdp(idc,2)),1)/rmas)**2
440  IF(sqrt(rm1)+sqrt(rm2).GT.1..OR.mdme(idc,1).LT.0) goto 180
441  IF(i.LE.8) THEN
442 C...Z'0 -> q + qb
443  ef=kchg(i,1)/3.
444  af=sign(1.,ef+0.1)
445  vf=af-4.*ef*xw
446  apf=sign(1.,ef+0.1)
447  vpf=apf-4.*ef*xw
448  IF(mint(61).EQ.0) THEN
449  wdtp(i)=3.*(vpf**2*(1.+2.*rm1)+apf**2*(1.-4.*rm1))*
450  & sqrt(max(0.,1.-4.*rm1))*radc
451  ELSEIF(mint(61).EQ.1) THEN
452  wdtp(i)=3.*((ggi*ef**2+gzi*ef*vf+gzpi*ef*vpf+zzi*vf**2+
453  & zzpi*vf*vpf+zpzpi*vpf**2)*(1.+2.*rm1)+(zzi*af**2+
454  & zzpi*af*apf+zpzpi*apf**2)*(1.-4.*rm1))*
455  & sqrt(max(0.,1.-4.*rm1))*radc
456  ELSEIF(mint(61).EQ.2) THEN
457  ggf=3.*ef**2*(1.+2.*rm1)*sqrt(max(0.,1.-4.*rm1))*radc
458  gzf=3.*ef*vf*(1.+2.*rm1)*sqrt(max(0.,1.-4.*rm1))*radc
459  gzpf=3.*ef*vpf*(1.+2.*rm1)*sqrt(max(0.,1.-4.*rm1))*radc
460  zzf=3.*(vf**2*(1.+2.*rm1)+af**2*(1.-4.*rm1))*
461  & sqrt(max(0.,1.-4.*rm1))*radc
462  zzpf=3.*(vf*vpf*(1.+2.*rm1)+af*apf*(1.-4.*rm1))*
463  & sqrt(max(0.,1.-4.*rm1))*radc
464  zpzpf=3.*(vpf**2*(1.+2.*rm1)+apf**2*(1.-4.*rm1))*
465  & sqrt(max(0.,1.-4.*rm1))*radc
466  ENDIF
467  wid2=1.
468  ELSE
469 C...Z'0 -> l+ + l-, nu + nub
470  ef=kchg(i+2,1)/3.
471  af=sign(1.,ef+0.1)
472  vf=af-4.*ef*xw
473  apf=sign(1.,ef+0.1)
474  vpf=api-4.*ef*xw
475  IF(mint(61).EQ.0) THEN
476  wdtp(i)=(vpf**2*(1.+2.*rm1)+apf**2*(1.-4.*rm1))*
477  & sqrt(max(0.,1.-4.*rm1))
478  ELSEIF(mint(61).EQ.1) THEN
479  wdtp(i)=((ggi*ef**2+gzi*ef*vf+gzpi*ef*vpf+zzi*vf**2+
480  & zzpi*vf*vpf+zpzpi*vpf**2)*(1.+2.*rm1)+(zzi*af**2+
481  & zzpi*af*apf+zpzpi*apf**2)*(1.-4.*rm1))*
482  & sqrt(max(0.,1.-4.*rm1))
483  ELSEIF(mint(61).EQ.2) THEN
484  ggf=ef**2*(1.+2.*rm1)*sqrt(max(0.,1.-4.*rm1))
485  gzf=ef*vf*(1.+2.*rm1)*sqrt(max(0.,1.-4.*rm1))
486  gzpf=ef*vpf*(1.+2.*rm1)*sqrt(max(0.,1.-4.*rm1))
487  zzf=(vf**2*(1.+2.*rm1)+af**2*(1.-4.*rm1))*
488  & sqrt(max(0.,1.-4.*rm1))
489  zzpf=(vf*vpf*(1.+2.*rm1)+af*apf*(1.-4.*rm1))*
490  & sqrt(max(0.,1.-4.*rm1))
491  zpzpf=(vpf**2*(1.+2.*rm1)+apf**2*(1.-4.*rm1))*
492  & sqrt(max(0.,1.-4.*rm1))
493  ENDIF
494  wid2=1.
495  ENDIF
496  wdtp(0)=wdtp(0)+wdtp(i)
497  IF(mdme(idc,1).GT.0) THEN
498  wdte(i,mdme(idc,1))=wdtp(i)*wid2
499  wdte(0,mdme(idc,1))=wdte(0,mdme(idc,1))+wdte(i,mdme(idc,1))
500  wdte(i,0)=wdte(i,mdme(idc,1))
501  wdte(0,0)=wdte(0,0)+wdte(i,0)
502  vint(111)=vint(111)+ggf
503  vint(112)=vint(112)+gzf
504  vint(113)=vint(113)+gzpf
505  vint(114)=vint(114)+zzf
506  vint(115)=vint(115)+zzpf
507  vint(116)=vint(116)+zpzpf
508  ENDIF
509  180 CONTINUE
510  IF(mstp(44).EQ.1) THEN
511 C...Only gamma* production included
512  vint(112)=0.
513  vint(113)=0.
514  vint(114)=0.
515  vint(115)=0.
516  vint(116)=0.
517  ELSEIF(mstp(44).EQ.2) THEN
518 C...Only Z0 production included
519  vint(111)=0.
520  vint(112)=0.
521  vint(113)=0.
522  vint(115)=0.
523  vint(116)=0.
524  ELSEIF(mstp(44).EQ.3) THEN
525 C...Only Z'0 production included
526  vint(111)=0.
527  vint(112)=0.
528  vint(113)=0.
529  vint(114)=0.
530  vint(115)=0.
531  ELSEIF(mstp(44).EQ.4) THEN
532 C...Only gamma*/Z0 production included
533  vint(113)=0.
534  vint(115)=0.
535  vint(116)=0.
536  ELSEIF(mstp(44).EQ.5) THEN
537 C...Only gamma*/Z'0 production included
538  vint(112)=0.
539  vint(114)=0.
540  vint(115)=0.
541  ELSEIF(mstp(44).EQ.6) THEN
542 C...Only Z0/Z'0 production included
543  vint(111)=0.
544  vint(112)=0.
545  vint(113)=0.
546  ENDIF
547 
548  ELSEIF(kfla.EQ.37) THEN
549 C...H+/-:
550  DO 190 i=1,mdcy(37,3)
551  idc=i+mdcy(37,2)-1
552  rm1=(pmas(iabs(kfdp(idc,1)),1)/rmas)**2
553  rm2=(pmas(iabs(kfdp(idc,2)),1)/rmas)**2
554  IF(sqrt(rm1)+sqrt(rm2).GT.1..OR.mdme(idc,1).LT.0) goto 190
555  IF(i.LE.4) THEN
556 C...H+/- -> q + qb'
557  wdtp(i)=3.*((rm1*paru(121)+rm2/paru(121))*
558  & (1.-rm1-rm2)-4.*rm1*rm2)*
559  & sqrt(max(0.,(1.-rm1-rm2)**2-4.*rm1*rm2))*radc
560  wid2=1.
561  ELSE
562 C...H+/- -> l+/- + nu
563  wdtp(i)=((rm1*paru(121)+rm2/paru(121))*
564  & (1.-rm1-rm2)-4.*rm1*rm2)*
565  & sqrt(max(0.,(1.-rm1-rm2)**2-4.*rm1*rm2))
566  wid2=1.
567  ENDIF
568  wdtp(0)=wdtp(0)+wdtp(i)
569  IF(mdme(idc,1).GT.0) THEN
570  wdte(i,mdme(idc,1))=wdtp(i)*wid2
571  wdte(0,mdme(idc,1))=wdte(0,mdme(idc,1))+wdte(i,mdme(idc,1))
572  wdte(i,0)=wdte(i,mdme(idc,1))
573  wdte(0,0)=wdte(0,0)+wdte(i,0)
574  ENDIF
575  190 CONTINUE
576 
577  ELSEIF(kfla.EQ.40) THEN
578 C...R:
579  DO 200 i=1,mdcy(40,3)
580  idc=i+mdcy(40,2)-1
581  rm1=(pmas(iabs(kfdp(idc,1)),1)/rmas)**2
582  rm2=(pmas(iabs(kfdp(idc,2)),1)/rmas)**2
583  IF(sqrt(rm1)+sqrt(rm2).GT.1..OR.mdme(idc,1).LT.0) goto 200
584  IF(i.LE.4) THEN
585 C...R -> q + qb'
586  wdtp(i)=3.*radc
587  wid2=1.
588  ELSE
589 C...R -> l+ + l'-
590  wdtp(i)=1.
591  wid2=1.
592  ENDIF
593  wdtp(0)=wdtp(0)+wdtp(i)
594  IF(mdme(idc,1).GT.0) THEN
595  wdte(i,mdme(idc,1))=wdtp(i)*wid2
596  wdte(0,mdme(idc,1))=wdte(0,mdme(idc,1))+wdte(i,mdme(idc,1))
597  wdte(i,0)=wdte(i,mdme(idc,1))
598  wdte(0,0)=wdte(0,0)+wdte(i,0)
599  ENDIF
600  200 CONTINUE
601 
602  ENDIF
603  mint(61)=0
604 
605  RETURN
606  END