]>
Commit | Line | Data |
---|---|---|
0795afa3 | 1 | #include "isajet/pilot.h" |
2 | SUBROUTINE SIGWW | |
3 | C | |
4 | C Calculate D(SIGMA)/D(PT**2)D(Y1)D(Y2) for QK+QB-->W+W | |
5 | C summed over W types allowed on JETTYPE cards and | |
6 | C including branching ratio implied by WMODE cards. | |
7 | C | |
8 | C SIGMA = cross section summed over quark types allowed by | |
9 | C JETTYPE card. | |
10 | C SIGS(I) = partial cross section for I1 + I2 --> I3 + I4. | |
11 | C INOUT(I) = IOPAK**3*I4 + IOPAK**2*I3 + IOPAK*I2 + I1 | |
12 | C using JETTYPE code. | |
13 | C | |
14 | C Cross sections from Brown and Mikaelian, | |
15 | C Phys Rev D19, 922, D20, 1164. | |
16 | C Include extra factor of 1/2 for double counting. | |
17 | C | |
18 | C Double precision needed for 32-bit machines. | |
19 | C | |
20 | C Ver. 6.22: Modified to used W + GM decay distributions from | |
21 | C Cortes, Hagiwara, and Herzog, NP B278, 26 (1986) | |
22 | C | |
23 | #if defined(CERNLIB_IMPNONE) | |
24 | IMPLICIT NONE | |
25 | #endif | |
26 | #include "isajet/itapes.inc" | |
27 | #include "isajet/qcdpar.inc" | |
28 | #include "isajet/jetpar.inc" | |
29 | #include "isajet/primar.inc" | |
30 | #include "isajet/q1q2.inc" | |
31 | #include "isajet/jetsig.inc" | |
32 | #include "isajet/const.inc" | |
33 | #include "isajet/qsave.inc" | |
34 | #include "isajet/wcon.inc" | |
35 | #include "isajet/wwpar.inc" | |
36 | C | |
37 | DIMENSION X(2),LISTW(4),QSGN(6) | |
38 | EQUIVALENCE (X(1),X1) | |
39 | EQUIVALENCE (S,SWW),(T,TWW),(U,UWW) | |
40 | #if defined(CERNLIB_SINGLE) | |
41 | REAL S,T,U,TX,UX,TT,UU | |
42 | $,WWA,WWI,WWE,WZA,WZI,WZE,TERM | |
43 | $,GA,GI,GE,GJ,GZ | |
44 | #endif | |
45 | #if defined(CERNLIB_DOUBLE) | |
46 | DOUBLE PRECISION S,T,U,TX,UX,TT,UU | |
47 | $,WWA,WWI,WWE,WZA,WZI,WZE,TERM | |
48 | $,GA,GI,GE,GJ,GZ | |
49 | #endif | |
50 | REAL WM2S,ZM2S,X,STRUC,FJAC,SGN,QSGN,SIG,FACTOR,EQ3(12) | |
51 | INTEGER I,IH,IQ,IW1,IW2,JW,JZ,IW,IQ1,IQ2,JG,LISTW,IFOUR | |
52 | INTEGER IFLI,IFLJ | |
53 | LOGICAL LQK1 | |
54 | C | |
55 | DATA LISTW/10,80,-80,90/ | |
56 | DATA QSGN/1.,-1.,-1.,1.,-1.,1./ | |
57 | DATA EQ3/2.,-1.,-1.,2.,-1.,2.,0.,-3.,0.,-3.,0.,-3./ | |
58 | C | |
59 | C Functions for W+W- | |
60 | WWA(S,T,U)=(U*T/WM2**2-1.)*(.25-WM2/S+3.*(WM2/S)**2)+S/WM2-4. | |
61 | WWI(S,T,U)=(U*T/WM2**2-1.)*(.25-.5*WM2/S-WM2**2/(S*T)) | |
62 | $+S/WM2-2.+2.*WM2/T | |
63 | WWE(S,T,U)=(U*T/WM2**2-1.)*(.25+(WM2/T)**2)+S/WM2 | |
64 | C Functions for W+-Z0 | |
65 | WZA(S,T,U)=(U*T/(WM2*ZM2)-1.)*(.25-(WM2+ZM2)/(2.*S) | |
66 | $+((WM2+ZM2)**2+8.*WM2*ZM2)/(4.*S**2)) | |
67 | $+(WM2+ZM2)/(WM2*ZM2)*(.5*S-WM2-ZM2+(WM2-ZM2)**2/(2.*S)) | |
68 | WZI(S,T,U)=.25*(U*T/(WM2*ZM2)-1.)*(1.-(WM2+ZM2)/S | |
69 | $-4.*WM2*ZM2/(S*T)) | |
70 | $+(WM2+ZM2)/(2.*WM2*ZM2)*(S-WM2-ZM2+2.*WM2*ZM2/T) | |
71 | WZE(S,T,U)=.25*(U*T/(WM2*ZM2)-1.)+.5*S*(WM2+ZM2)/(WM2*ZM2) | |
72 | C | |
73 | C Initialize | |
74 | DO 10 I=1,MXSIGS | |
75 | 10 SIGS(I)=0. | |
76 | SIGMA=0. | |
77 | NSIGS=0 | |
78 | C | |
79 | C Convention is that even for double precision single | |
80 | C precision mass is exact. | |
81 | WM2=WMASS(2) | |
82 | WM2=WM2**2 | |
83 | ZM2=WMASS(4) | |
84 | ZM2=ZM2**2 | |
85 | C Also need single precision mass**2. | |
86 | WM2S=WM2 | |
87 | ZM2S=ZM2 | |
88 | C | |
89 | C W+ W- pairs | |
90 | C | |
91 | IF(.NOT.((GOQ(2,1).AND.GOQ(3,2)).OR.(GOQ(3,1).AND.GOQ(2,2)))) | |
92 | $GO TO 200 | |
93 | CALL WWKIN(WMASS(2),WMASS(2)) | |
94 | IF(X1.GE.1..OR.X2.GE.1.) GO TO 200 | |
95 | DO 110 IH=1,2 | |
96 | DO 110 IQ=2,9 | |
97 | 110 QSAVE(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH) | |
98 | FJAC=S/SCM*UNITS | |
99 | FJAC=FJAC*PI*ALFA**2/(3.*S**2) | |
100 | FJAC=FJAC*P(1)*P(2)/SQRT((P(1)**2+WM2S)*(P(2)**2+WM2S)) | |
101 | FJAC=.5*FJAC | |
102 | C Sum over jet1 = W+ and jet2 = W+. | |
103 | C Swap t and u in latter case. | |
104 | DO 120 IW1=2,3 | |
105 | IW2=5-IW1 | |
106 | IF(.NOT.(GOQ(IW1,1).AND.GOQ(IW2,2))) GO TO 120 | |
107 | IF(IW1.EQ.3) GO TO 121 | |
108 | TX=T | |
109 | UX=U | |
110 | GO TO 122 | |
111 | 121 TX=U | |
112 | UX=T | |
113 | C | |
114 | C Sum over quarks, swapping t and u for negative charge. | |
115 | 122 DO 130 IQ=1,4 | |
116 | GA=2.*(AQDP(IQ,1)+EZDP*AQDP(IQ,4)*S/(S-ZM2))**2 | |
117 | $+2.*(EZDP*BQDP(IQ,4)*S/(S-ZM2))**2 | |
118 | GI=8.*(AQDP(IQ,1)+EZDP*(AQDP(IQ,4)+BQDP(IQ,4))*S/(S-ZM2)) | |
119 | $*(AQDP(IQ,2))**2 | |
120 | GE=16.*(AQDP(IQ,2))**4 | |
121 | SGN=QSGN(IQ) | |
122 | IF(SGN.LT.0.) GO TO 131 | |
123 | TT=TX | |
124 | UU=UX | |
125 | GO TO 132 | |
126 | 131 TT=UX | |
127 | UU=TX | |
128 | 132 SIG=QSAVE(2*IQ,1)*QSAVE(2*IQ+1,2)*FJAC*TBRWW(IW1,1)*TBRWW(IW2,2) | |
129 | $*(GA*WWA(S,TT,UU)-SGN*GI*WWI(S,TT,UU)+GE*WWE(S,TT,UU)) | |
130 | CALL SIGFIL(SIG,2*IQ,2*IQ+1,IW1,IW2) | |
131 | SIG=QSAVE(2*IQ+1,1)*QSAVE(2*IQ,2)*FJAC*TBRWW(IW1,1)*TBRWW(IW2,2) | |
132 | $*(GA*WWA(S,UU,TT)-SGN*GI*WWI(S,UU,TT)+GE*WWE(S,UU,TT)) | |
133 | CALL SIGFIL(SIG,2*IQ+1,2*IQ,IW1,IW2) | |
134 | 130 CONTINUE | |
135 | 120 CONTINUE | |
136 | C | |
137 | C Z0 Z0 pairs | |
138 | C | |
139 | 200 IF(.NOT.(GOQ(4,1).AND.GOQ(4,2))) GO TO 300 | |
140 | CALL WWKIN(WMASS(4),WMASS(4)) | |
141 | IF(X1.GE.1..OR.X2.GE.1.) RETURN | |
142 | DO 210 IH=1,2 | |
143 | DO 210 IQ=2,9 | |
144 | 210 QSAVE(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH) | |
145 | C Jacobean -- including factor of 1/2 for identical particles. | |
146 | FJAC=.5*S/SCM*UNITS | |
147 | FJAC=FJAC*PI*ALFA**2/(3.*S**2) | |
148 | FJAC=FJAC*P(1)*P(2)/SQRT((P(1)**2+ZM2S)*(P(2)**2+ZM2S)) | |
149 | DO 220 IQ=1,4 | |
150 | GZ=2.*(AQDP(IQ,4)**4+BQDP(IQ,4)**4 | |
151 | $+6.*AQDP(IQ,4)**2*BQDP(IQ,4)**2) | |
152 | FACTOR=(T/U+U/T+4.*ZM2*S/(T*U)-ZM2**2*(1./T**2+1./U**2)) | |
153 | FACTOR=FACTOR*FJAC*GZ*TBRWW(4,1)*TBRWW(4,2) | |
154 | SIG=FACTOR*QSAVE(2*IQ,1)*QSAVE(2*IQ+1,2) | |
155 | CALL SIGFIL(SIG,2*IQ,2*IQ+1,4,4) | |
156 | SIG=FACTOR*QSAVE(2*IQ+1,1)*QSAVE(2*IQ,2) | |
157 | CALL SIGFIL(SIG,2*IQ+1,2*IQ,4,4) | |
158 | 220 CONTINUE | |
159 | C | |
160 | C W+- Z0 pairs | |
161 | C | |
162 | C JW and JZ are W+- and Z0 jet numbers. | |
163 | 300 DO 310 JW=1,2 | |
164 | JZ=3-JW | |
165 | IF(.NOT.((GOQ(2,JW).OR.GOQ(3,JW)).AND.GOQ(4,JZ))) GO TO 310 | |
166 | C | |
167 | C Must swap t and u if JW=2. | |
168 | IF(JW.EQ.1) THEN | |
169 | CALL WWKIN(WMASS(2),WMASS(4)) | |
170 | TX=T | |
171 | UX=U | |
172 | FJAC=S/SCM*UNITS | |
173 | FJAC=FJAC*PI*ALFA**2/(3.*S**2) | |
174 | FJAC=.5*FJAC | |
175 | FJAC=FJAC*P(1)*P(2)/SQRT((P(1)**2+WM2S)*(P(2)**2+ZM2S)) | |
176 | ELSE | |
177 | CALL WWKIN(WMASS(4),WMASS(2)) | |
178 | TX=U | |
179 | UX=T | |
180 | FJAC=S/SCM*UNITS | |
181 | FJAC=FJAC*PI*ALFA**2/(3.*S**2) | |
182 | FJAC=.5*FJAC | |
183 | FJAC=FJAC*P(1)*P(2)/SQRT((P(1)**2+ZM2S)*(P(2)**2+WM2S)) | |
184 | ENDIF | |
185 | IF(X1.GE.1..OR.X2.GE.1.) GO TO 310 | |
186 | DO 320 IH=1,2 | |
187 | DO 320 IQ=1,9 | |
188 | 320 QSAVE(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH) | |
189 | C | |
190 | C Sum over W+ and W- | |
191 | DO 340 IW=2,3 | |
192 | IF(IW.EQ.2) THEN | |
193 | SGN=+1 | |
194 | ELSE | |
195 | SGN=+1 | |
196 | ENDIF | |
197 | C | |
198 | C Sum over quarks, swapping t and u as needed. | |
199 | DO 350 IQ1=2,9 | |
200 | IQ2=MATCH(IQ1,IW) | |
201 | IF(IQ2.EQ.0) GO TO 350 | |
202 | IQ=IQ1/2 | |
203 | IF(2*IQ.EQ.IQ1) THEN | |
204 | LQK1=.TRUE. | |
205 | ELSE | |
206 | LQK1=.FALSE. | |
207 | ENDIF | |
208 | IF((LQK1.AND.IW.EQ.3).OR.(.NOT.LQK1.AND.IW.EQ.2)) THEN | |
209 | TT=TX | |
210 | UU=UX | |
211 | IFLI=IQ1/2 | |
212 | IFLJ=IQ2/2 | |
213 | ELSE | |
214 | TT=UX | |
215 | UU=TX | |
216 | IFLI=IQ2/2 | |
217 | IFLJ=IQ1/2 | |
218 | ENDIF | |
219 | C | |
220 | GA=AQDP(IQ,IW)*EZDP*S/(S-WM2) | |
221 | GI=AQDP(IQ,IW)*(AQDP(IFLI,4)+BQDP(IFLI,4)) | |
222 | GJ=AQDP(IQ,IW)*(AQDP(IFLJ,4)+BQDP(IFLJ,4)) | |
223 | TERM=GA**2*WZA(S,TT,UU) | |
224 | TERM=TERM+2.*GA*SGN*(-GJ*WZI(S,TT,UU)+GI*WZI(S,UU,TT)) | |
225 | TERM=TERM+(GI-GJ)**2*WZE(S,TT,UU) | |
226 | TERM=TERM+GI**2*(UU*TT-WM2*ZM2)/UU**2 | |
227 | $ +2.*GI*GJ*S*(WM2+ZM2)/(TT*UU)+GJ**2*(UU*TT-WM2*ZM2)/TT**2 | |
228 | TERM=TERM*4.*FJAC*QSAVE(IQ1,1)*QSAVE(IQ2,2) | |
229 | TERM=TERM*TBRWW(IW,JW)*TBRWW(4,JZ) | |
230 | SIG=TERM | |
231 | IF(JW.EQ.1) THEN | |
232 | CALL SIGFIL(SIG,IQ1,IQ2,IW,4) | |
233 | ELSE | |
234 | CALL SIGFIL(SIG,IQ1,IQ2,4,IW) | |
235 | ENDIF | |
236 | 350 CONTINUE | |
237 | 340 CONTINUE | |
238 | 310 CONTINUE | |
239 | C | |
240 | C W+- GM pairs. | |
241 | C | |
242 | 400 DO 410 JW=1,2 | |
243 | JG=3-JW | |
244 | IF(.NOT.((GOQ(2,JW).OR.GOQ(3,JW)).AND.GOQ(1,JG))) GO TO 410 | |
245 | C | |
246 | C Must swap t and u if JW=2. | |
247 | IF(JW.EQ.1) THEN | |
248 | CALL WWKIN(WMASS(2),0.) | |
249 | TX=T | |
250 | UX=U | |
251 | FJAC=S/SCM*UNITS | |
252 | FJAC=FJAC*PI*ALFA**2/S**2 | |
253 | FJAC=.5*FJAC | |
254 | FJAC=FJAC*P(1)/SQRT(P(1)**2+WM2S) | |
255 | ELSE | |
256 | CALL WWKIN(0.,WMASS(2)) | |
257 | TX=U | |
258 | UX=T | |
259 | FJAC=S/SCM*UNITS | |
260 | FJAC=FJAC*PI*ALFA**2/S**2 | |
261 | FJAC=.5*FJAC | |
262 | FJAC=FJAC*P(2)/SQRT(P(2)**2+WM2S) | |
263 | ENDIF | |
264 | C | |
265 | IF(X1.GE.1..OR.X2.GE.1.) GO TO 410 | |
266 | DO 420 IH=1,2 | |
267 | DO 420 IQ=1,9 | |
268 | 420 QSAVE(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH) | |
269 | C | |
270 | C Sum over W+ and W- | |
271 | DO 440 IW=2,3 | |
272 | C | |
273 | C Sum over quarks, swapping t and u as needed. | |
274 | DO 450 IQ1=2,9 | |
275 | IQ2=MATCH(IQ1,IW) | |
276 | IF(IQ2.EQ.0) GO TO 450 | |
277 | IQ=IQ1/2 | |
278 | IF(2*IQ.EQ.IQ1) THEN | |
279 | LQK1=.TRUE. | |
280 | ELSE | |
281 | LQK1=.FALSE. | |
282 | ENDIF | |
283 | IF((LQK1.AND.IW.EQ.3).OR.(.NOT.LQK1.AND.IW.EQ.2)) THEN | |
284 | TT=TX | |
285 | UU=UX | |
286 | ELSE | |
287 | TT=UX | |
288 | UU=TX | |
289 | ENDIF | |
290 | C | |
291 | SIG=TBRWW(IW,JW)/(6.*SIN2W)*(-1./3.+UU/(TT+UU))**2 | |
292 | $ *(UU**2+TT**2+2.*S*WM2)/(TT*UU) | |
293 | SIG=SIG*FJAC*QSAVE(IQ1,1)*QSAVE(IQ2,2) | |
294 | IF(JW.EQ.1) CALL SIGFIL(SIG,IQ1,IQ2,IW,1) | |
295 | IF(JW.EQ.2) CALL SIGFIL(SIG,IQ1,IQ2,1,IW) | |
296 | 450 CONTINUE | |
297 | 440 CONTINUE | |
298 | 410 CONTINUE | |
299 | C | |
300 | C Z0 GM pairs | |
301 | C | |
302 | IF (GOQ(4,1).AND.GOQ(1,2)) THEN | |
303 | CALL WWKIN(WMASS(4),0.) | |
304 | IF(X1.GE.1..OR.X2.GE.1.) GO TO 500 | |
305 | DO 510 IH=1,2 | |
306 | DO 510 IQ=2,9 | |
307 | 510 QSAVE(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH) | |
308 | FJAC=S/SCM*P(1)/SQRT(P(1)**2+ZM2S)*UNITS | |
309 | FJAC=FJAC*PI*ALFA**2/(3.*S**2) | |
310 | DO 520 IQ=1,4 | |
311 | GZ=AQDP(IQ,4)**2+(AQDP(IQ,4)-BQDP(IQ,4))**2 | |
312 | FACTOR=(S**2+ZM2**2)/2./T/U+1. | |
313 | FACTOR=(EQ3(IQ)/3.)**2*FACTOR*FJAC*GZ*TBRWW(4,1) | |
314 | SIG=FACTOR*QSAVE(2*IQ,1)*QSAVE(2*IQ+1,2) | |
315 | CALL SIGFIL(SIG,2*IQ,2*IQ+1,4,1) | |
316 | SIG=FACTOR*QSAVE(2*IQ+1,1)*QSAVE(2*IQ,2) | |
317 | CALL SIGFIL(SIG,2*IQ+1,2*IQ,4,1) | |
318 | 520 CONTINUE | |
319 | 500 CONTINUE | |
320 | END IF | |
321 | C | |
322 | IF (GOQ(1,1).AND.GOQ(4,2)) THEN | |
323 | CALL WWKIN(0.,WMASS(4)) | |
324 | IF(X1.GE.1..OR.X2.GE.1.) GO TO 600 | |
325 | DO 610 IH=1,2 | |
326 | DO 610 IQ=2,9 | |
327 | 610 QSAVE(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH) | |
328 | FJAC=S/SCM*P(2)/SQRT(P(2)**2+ZM2S)*UNITS | |
329 | FJAC=FJAC*PI*ALFA**2/(3.*S**2) | |
330 | DO 620 IQ=1,4 | |
331 | GZ=AQDP(IQ,4)**2+(AQDP(IQ,4)-BQDP(IQ,4))**2 | |
332 | FACTOR=(S**2+ZM2**2)/2./T/U+1. | |
333 | FACTOR=(EQ3(IQ)/3.)**2*FACTOR*FJAC*GZ*TBRWW(4,2) | |
334 | SIG=FACTOR*QSAVE(2*IQ,1)*QSAVE(2*IQ+1,2) | |
335 | CALL SIGFIL(SIG,2*IQ,2*IQ+1,1,4) | |
336 | SIG=FACTOR*QSAVE(2*IQ+1,1)*QSAVE(2*IQ,2) | |
337 | CALL SIGFIL(SIG,2*IQ+1,2*IQ,1,4) | |
338 | 620 CONTINUE | |
339 | 600 CONTINUE | |
340 | END IF | |
341 | C | |
342 | RETURN | |
343 | END |