2 C*********************************************************************
6 C...Calculates full and effective widths of gauge bosons, stores
7 C...masses and widths, rescales coefficients to be used for
8 C...resonance production generation.
9 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
10 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
11 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
12 COMMON/LUDAT4/CHAF(500)
14 COMMON/PYSUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
15 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
16 COMMON/PYINT1/MINT(400),VINT(400)
17 COMMON/PYINT2/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2)
18 COMMON/PYINT4/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3)
19 COMMON/PYINT6/PROC(0:200)
21 SAVE /LUDAT1/,/LUDAT2/,/LUDAT3/,/LUDAT4/
22 SAVE /PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT4/,/PYINT6/
23 DIMENSION WDTP(0:40),WDTE(0:40,0:5),WDTPM(0:40),WDTEM(0:40,0:5)
24 DIMENSION KCINP(16),KCORD(16),PMORD(16)
25 DATA KCINP/23,24,25,6,7,8,17,18,32,34,35,36,37,38,39,40/
27 C...Born level couplings in MSSM Higgs doublet sector.
30 IF(MSTP(8).GE.2) XW=1.-(PMAS(24,1)/PMAS(23,1))**2
34 RATBE=((1.-TANBE**2)/(1.+TANBE**2))**2
38 SQMA=SQMH*(SQMZ-SQMH)/(SQMZ*RATBE-SQMH)
39 SQMHP=0.5*(SQMA+SQMZ+SQRT((SQMA+SQMZ)**2-4.*SQMA*SQMZ*RATBE))
41 IF(SQMH.GE.SQMZ.OR.MIN(SQMA,SQMHP,SQMHC).LE.0.) THEN
45 PMAS(35,1)=SQRT(SQMHP)
47 PMAS(37,1)=SQRT(SQMHC)
48 ALSU=0.5*ATAN(2.*TANBE*(SQMA+SQMZ)/((1.-TANBE**2)*
53 PARU(161)=-SIN(ALSU)/COS(BESU)
54 PARU(162)=COS(ALSU)/SIN(BESU)
56 PARU(164)=SIN(BESU-ALSU)
58 PARU(168)=SIN(BESU-ALSU)+0.5*COS(2.*BESU)*SIN(BESU+ALSU)/XW
59 PARU(171)=COS(ALSU)/COS(BESU)
60 PARU(172)=SIN(ALSU)/SIN(BESU)
62 PARU(174)=COS(BESU-ALSU)
64 PARU(176)=COS(2.*ALSU)*COS(BESU+ALSU)-2.*SIN(2.*ALSU)*
66 PARU(177)=COS(2.*BESU)*COS(BESU+ALSU)
67 PARU(178)=COS(BESU-ALSU)-0.5*COS(2.*BESU)*COS(BESU+ALSU)/XW
73 PARU(186)=COS(BESU-ALSU)
74 PARU(187)=SIN(BESU-ALSU)
78 PARU(195)=COS(BESU-ALSU)
81 C...Change matrix element codes when top and 4th generation
82 C...decay before fragmentation.
83 IF(MSTP(48).GE.1) THEN
106 ELSEIF(MSTP(49).GE.1) THEN
127 C...Reset full and effective widths of gauge bosons.
138 C...Order resonances by increasing mass (except Z0 and W+/-).
141 PMORD(I)=PMAS(KCORD(I),1)
147 IF(PMIN.GE.PMORD(I1)) GOTO 190
148 KCORD(I1+1)=KCORD(I1)
149 PMORD(I1+1)=PMORD(I1)
155 C...Loop over possible resonances.
158 IF(KC.EQ.6.AND.MSTP(48).LE.0) GOTO 250
159 IF(KC.EQ.7.OR.KC.EQ.8.OR.KC.EQ.17.OR.KC.EQ.18) THEN
160 IF(MSTP(6).NE.1.AND.(MSTP(49).LE.0.OR.MSTP(1).LE.3)) GOTO 250
161 IF(KC.EQ.18.AND.PMORD(I).LT.1.) GOTO 250
164 IF(KC.GE.6.AND.KC.LE.8) KCL=KC+20
165 IF(KC.EQ.17.OR.KC.EQ.18) KCL=KC+12
167 C...Change decay modes for q* and l*.
168 IF(MSTP(6).EQ.1.AND.(KC.EQ.7.OR.KC.EQ.8.OR.KC.EQ.17.OR.
170 DO 210 J=1,MDCY(KC,3)
173 IF(KF2.EQ.7.OR.KF2.EQ.8.OR.KF2.EQ.17.OR.KF2.EQ.18)
178 C...Check that no fourth generation channels on by mistake.
179 IF(MSTP(1).LE.3) THEN
180 DO 220 J=1,MDCY(KC,3)
182 KFA1=IABS(KFDP(IDC,1))
183 KFA2=IABS(KFDP(IDC,2))
184 IF(KFA1.EQ.7.OR.KFA1.EQ.8.OR.KFA1.EQ.17.OR.KFA1.EQ.18.OR.KFA2
185 & .EQ.7.OR.KFA2.EQ.8.OR.KFA2.EQ.17.OR.KFA2.EQ.18) MDME(IDC,1)=-1
189 C...Find mass and evaluate width.
191 IF(KC.EQ.25.OR.KC.EQ.35.OR.KC.EQ.36) MINT(62)=1
192 CALL PYWIDT(KC,PMR**2,WDTP,WDTE)
193 IF(KC.EQ.6.OR.KC.EQ.7.OR.KC.EQ.8.OR.KC.EQ.17.OR.KC.EQ.18)
194 &CALL PYWIDT(-KC,PMR**2,WDTPM,WDTEM)
197 C...Evaluate suppression factors due to non-simulated channels.
198 IF(KCHG(KC,3).EQ.0) THEN
199 WIDS(KCL,1)=((WDTE(0,1)+WDTE(0,2))**2+
200 & 2.*(WDTE(0,1)+WDTE(0,2))*(WDTE(0,4)+WDTE(0,5))+
201 & 2.*WDTE(0,4)*WDTE(0,5))/WDTP(0)**2
202 WIDS(KCL,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0)
204 ELSEIF(KC.EQ.6.OR.KC.EQ.7.OR.KC.EQ.8.OR.KC.EQ.17.OR.KC.EQ.18) THEN
205 WIDS(KCL,1)=((WDTE(0,1)+WDTE(0,2))*(WDTEM(0,1)+WDTEM(0,3))+
206 & (WDTE(0,1)+WDTE(0,2))*(WDTEM(0,4)+WDTEM(0,5))+
207 & (WDTE(0,4)+WDTE(0,5))*(WDTEM(0,1)+WDTEM(0,3))+
208 & WDTE(0,4)*WDTEM(0,5)+WDTE(0,5)*WDTEM(0,4))/WDTP(0)**2
209 WIDS(KCL,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0)
210 WIDS(KCL,3)=(WDTEM(0,1)+WDTEM(0,3)+WDTEM(0,4))/WDTP(0)
212 WIDS(KCL,1)=((WDTE(0,1)+WDTE(0,2))*(WDTE(0,1)+WDTE(0,3))+
213 & (WDTE(0,1)+WDTE(0,2)+WDTE(0,1)+WDTE(0,3))*(WDTE(0,4)+WDTE(0,5))+
214 & 2.*WDTE(0,4)*WDTE(0,5))/WDTP(0)**2
215 WIDS(KCL,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0)
216 WIDS(KCL,3)=(WDTE(0,1)+WDTE(0,3)+WDTE(0,4))/WDTP(0)
218 VINT(91)=((WDTE(0,1)+WDTE(0,2))**2+2.*(WDTE(0,1)+WDTE(0,2))*
219 & (WDTE(0,4)+WDTE(0,5))+2.*WDTE(0,4)*WDTE(0,5))/WDTP(0)**2
220 VINT(92)=((WDTE(0,1)+WDTE(0,3))**2+2.*(WDTE(0,1)+WDTE(0,3))*
221 & (WDTE(0,4)+WDTE(0,5))+2.*WDTE(0,4)*WDTE(0,5))/WDTP(0)**2
225 C...Find factors to give widths in GeV.
227 IF(MSTP(8).GE.1) AEM=SQRT(2.)*PARU(105)*PMAS(24,1)**2*XW/PARU(1)
230 ELSEIF(KC.EQ.23.OR.KC.EQ.32) THEN
231 FAC=AEM/(48.*XW*XW1)*PMR
232 ELSEIF(KC.EQ.24.OR.KC.EQ.34) THEN
234 ELSEIF(KC.EQ.25.OR.KC.EQ.35.OR.KC.EQ.36.OR.KC.EQ.37) THEN
235 FAC=AEM/(8.*XW)*(PMR/PMAS(24,1))**2*PMR
236 ELSEIF(KC.EQ.38) THEN
238 ELSEIF(KC.EQ.39) THEN
240 ELSEIF(KC.EQ.40) THEN
244 C...Translate widths into GeV and save them.
246 WIDP(KCL,J)=FAC*WDTP(J)
247 WIDE(KCL,J)=FAC*WDTE(J,0)
250 C...Set resonance widths and branching ratios in JETSET;
251 C...also on/off switch for decays in PYTHIA/JETSET.
252 PMAS(KC,2)=WIDP(KCL,0)
253 PMAS(KC,3)=MIN(0.9*PMAS(KC,1),10.*PMAS(KC,2))
255 DO 240 J=1,MDCY(KC,3)
258 IF(WIDE(KCL,0).GT.0.) BRAT(IDC)=WIDE(KCL,J)/WIDE(KCL,0)
262 C...Flavours of leptoquark: redefine charge and name.
263 KFLQQ=KFDP(MDCY(39,2),1)
264 KFLQL=KFDP(MDCY(39,2),2)
265 KCHG(39,1)=KCHG(IABS(KFLQQ),1)*ISIGN(1,KFLQQ)+
266 &KCHG(IABS(KFLQL),1)*ISIGN(1,KFLQL)
267 CHAF(39)(4:4)=CHAF(IABS(KFLQQ))(1:1)
268 CHAF(39)(5:7)=CHAF(IABS(KFLQL))(1:3)
270 C...Scenario with q* and l*: redefine names.
271 IF(MSTP(6).EQ.1) THEN
278 C...Special cases in treatment of gamma*/Z0: redefine process name.
279 IF(MSTP(43).EQ.1) THEN
280 PROC(1)='f + f~ -> gamma*'
281 PROC(15)='f + f~ -> g + gamma*'
282 PROC(19)='f + f~ -> gamma + gamma*'
283 PROC(30)='f + g -> f + gamma*'
284 PROC(35)='f + gamma -> f + gamma*'
285 ELSEIF(MSTP(43).EQ.2) THEN
286 PROC(1)='f + f~ -> Z0'
287 PROC(15)='f + f~ -> g + Z0'
288 PROC(19)='f + f~ -> gamma + Z0'
289 PROC(30)='f + g -> f + Z0'
290 PROC(35)='f + gamma -> f + Z0'
291 ELSEIF(MSTP(43).EQ.3) THEN
292 PROC(1)='f + f~ -> gamma*/Z0'
293 PROC(15)='f + f~ -> g + gamma*/Z0'
294 PROC(19)='f + f~ -> gamma + gamma*/Z0'
295 PROC(30)='f + g -> f + gamma*/Z0'
296 PROC(35)='f + gamma -> f + gamma*/Z0'
299 C...Special cases in treatment of gamma*/Z0/Z'0: redefine process name.
300 IF(MSTP(44).EQ.1) THEN
301 PROC(141)='f + f~ -> gamma*'
302 ELSEIF(MSTP(44).EQ.2) THEN
303 PROC(141)='f + f~ -> Z0'
304 ELSEIF(MSTP(44).EQ.3) THEN
305 PROC(141)='f + f~ -> Z''0'
306 ELSEIF(MSTP(44).EQ.4) THEN
307 PROC(141)='f + f~ -> gamma*/Z0'
308 ELSEIF(MSTP(44).EQ.5) THEN
309 PROC(141)='f + f~ -> gamma*/Z''0'
310 ELSEIF(MSTP(44).EQ.6) THEN
311 PROC(141)='f + f~ -> Z0/Z''0'
312 ELSEIF(MSTP(44).EQ.7) THEN
313 PROC(141)='f + f~ -> gamma*/Z0/Z''0'
316 C...Special cases in treatment of WW -> WW: redefine process name.
317 IF(MSTP(45).EQ.1) THEN
318 PROC(77)='W+ + W+ -> W+ + W+'
319 ELSEIF(MSTP(45).EQ.2) THEN
320 PROC(77)='W+ + W- -> W+ + W-'
321 ELSEIF(MSTP(45).EQ.3) THEN
322 PROC(77)='W+/- + W+/- -> W+/- + W+/-'
325 C...Format for error information.
326 5000 FORMAT(1X,'Error: unphysical input tan^2(beta) and m_H ',
327 &'combination'/1X,'Execution stopped!')