ISAJET/code/sigww.F

   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