| 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 |
git://git.uio.no / u / mrichter / AliRoot.git / blame