ISAJET/code/sigqcd.F

   1 #include "isajet/pilot.h"
   2       SUBROUTINE SIGQCD
   3 C
   4 C          Compute D(SIGMA)/D(PT**2)D(Y1)D(Y2)
   5 C          Include quark masses for ch, bt, and tp and 4th generation.
   6 C          Note ch is now treated as heavy.
   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 Feynman, Field and Fox, P.R. D18, 3320
  15 C          Massive cross sections from B. Combridge, N.P. B151, 429.
  16 C          Extra factor of 1/2 needed for  non-identical jets since all
  17 C          all jets are treated as identical.
  18 C
  19 C          Ver 6.35: Fix kinematics for gl + tp -> gl + tp, etc.
  20 C
  21 #if defined(CERNLIB_IMPNONE)
  22       IMPLICIT NONE
  23 #endif
  24 #include "isajet/itapes.inc"
  25 #include "isajet/qcdpar.inc"
  26 #include "isajet/jetpar.inc"
  27 #include "isajet/primar.inc"
  28 #include "isajet/q1q2.inc"
  29 #include "isajet/jetsig.inc"
  30 #include "isajet/const.inc"
  31 C
  32       REAL    X(2),QSAVE(13,2),EBT(2)
  33       EQUIVALENCE (X(1),X1),(S,SHAT),(T,THAT),(U,UHAT)
  34       REAL    FFF1,FFF2,FFF3,FFF4,FFF5,FFF6,FFF7,S,T,U,FGQ,AM2,FQQ,
  35      $        QFCN,STRUC,FJAC,SIG,AMASS,SIG1,AMQ,FJACBT,SIG2,QQ,XQMIN,
  36      $        E1,E2
  37       INTEGER IQ,IH,I,J,IFL,JTYP1,JTYP2,IQ1,IQ2
  38 C
  39 C          Elementary cross sections from Feynman, Field, and Fox.
  40 C
  41       FFF1(S,T,U)=4./9.*(S**2+U**2)/T**2
  42       FFF2(S,T,U)=4./9.*((S**2+U**2)/T**2+(S**2+T**2)/U**2)
  43      1-8./27.*S**2/(U*T)
  44       FFF3(S,T,U)=4./9.*((S**2+U**2)/T**2+(T**2+U**2)/S**2)
  45      1-8./27.*U**2/(S*T)
  46       FFF4(S,T,U)=32./27.*(U**2+T**2)/(U*T)-8./3.*(U**2+T**2)/S**2
  47       FFF5(S,T,U)=1./6.*(U**2+T**2)/(U*T)-3./8.*(U**2+T**2)/S**2
  48       FFF6(S,T,U)=-4./9.*(U**2+S**2)/(U*S)+(U**2+S**2)/T**2
  49       FFF7(S,T,U)=9./2.*(3.-U*T/S**2-U*S/T**2-S*T/U**2)
  50 C          Heavy quark cross sections from Combridge
  51       FGQ(S,T,U)=2.*(S-AM2)*(AM2-U)/T**2
  52      1+4./9.*((S-AM2)*(AM2-U)+2.*AM2*(S+AM2))/(S-AM2)**2
  53      2+4./9.*((S-AM2)*(AM2-U)+2.*AM2*(AM2+U))/(AM2-U)**2
  54      3+1./9.*AM2*(4.*AM2-T)/((S-AM2)*(AM2-U))
  55      4+((S-AM2)*(AM2-U)+AM2*(S-U))/(T*(S-AM2))
  56      5-((S-AM2)*(AM2-U)-AM2*(S-U))/(T*(AM2-U))
  57       FQQ(S,T,U)=4./9.*((AM2-U)**2+(S-AM2)**2+2.*AM2*T)/T**2
  58       QFCN(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH)
  59 C
  60 C          Use massless kinematics for ch and lighter quarks.
  61 C
  62       CALL TWOKIN(0.,0.,0.,0.)
  63       FJAC=SHAT/SCM*UNITS
  64       FJAC=FJAC*PI*ALFQSQ**2/SHAT**2
  65 C
  66 C          Initialize cross sections.
  67 C
  68       SIGMA=0.
  69       NSIGS=0
  70       DO 100 I=1,MXSIGS
  71         SIGS(I)=0.
  72 100   CONTINUE
  73       IF(X1.GE.1.0.OR.X2.GE.1.0) RETURN
  74 C          Compute structure functions
  75       DO 110 IH=1,2
  76       DO 110 IQ=1,7
  77         QSAVE(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH)
  78 110   CONTINUE
  79 C
  80 C          Compute cross sections summed over quark types allowed by
  81 C          JETTYPE card.
  82 C
  83 C          Gluon-gluon
  84       IF(.NOT.(GOQ(1,1).AND.GOQ(1,2))) GO TO 210
  85       SIG=.5*FJAC*QSAVE(1,1)*QSAVE(1,2)*FFF7(S,T,U)
  86       CALL SIGFIL(SIG,1,1,1,1)
  87 C
  88       DO 201 I=1,3
  89         SIG=.5*FJAC*QSAVE(2*I,1)*QSAVE(2*I+1,2)*FFF4(S,T,U)
  90         CALL SIGFIL(SIG,2*I,2*I+1,1,1)
  91         SIG=.5*FJAC*QSAVE(2*I+1,1)*QSAVE(2*I,2)*FFF4(S,U,T)
  92         CALL SIGFIL(SIG,2*I+1,2*I,1,1)
  93 201   CONTINUE
  94 C
  95 C          Quark-gluon
  96 210   CONTINUE
  97       DO 211 I=2,7
  98         IF(.NOT.(GOQ(I,1).AND.GOQ(1,2))) GO TO 212
  99         SIG=.5*FJAC*QSAVE(I,1)*QSAVE(1,2)*FFF6(S,T,U)
 100         CALL SIGFIL(SIG,I,1,I,1)
 101         SIG=.5*FJAC*QSAVE(1,1)*QSAVE(I,2)*FFF6(S,U,T)
 102         CALL SIGFIL(SIG,1,I,I,1)
 103 212     CONTINUE
 104         IF(.NOT.(GOQ(1,1).AND.GOQ(I,2))) GO TO 211
 105         SIG=.5*FJAC*QSAVE(1,1)*QSAVE(I,2)*FFF6(S,T,U)
 106         CALL SIGFIL(SIG,1,I,1,I)
 107         SIG=.5*FJAC*QSAVE(I,1)*QSAVE(1,2)*FFF6(S,U,T)
 108         CALL SIGFIL(SIG,I,1,1,I)
 109 211   CONTINUE
 110 C
 111 C          Identical quark-quark
 112       DO 220 I=2,7
 113         IF(.NOT.(GOQ(I,1).AND.GOQ(I,2))) GO TO 220
 114         SIG=.5*FJAC*QSAVE(I,1)*QSAVE(I,2)*FFF2(S,T,U)
 115         CALL SIGFIL(SIG,I,I,I,I)
 116 220   CONTINUE
 117 C
 118 C          Identical quark-antiquark
 119       DO 230 I=1,3
 120         IF(SHAT.LT.4.*AMASS(I)**2) GO TO 230
 121         IF(.NOT.(GOQ(2*I,1).AND.GOQ(2*I+1,2))) GO TO 235
 122         SIG=.5*FJAC*QSAVE(1,1)*QSAVE(1,2)*FFF5(S,T,U)
 123         CALL SIGFIL(SIG,1,1,2*I,2*I+1)
 124         DO 231 J=1,3
 125           IF(J.EQ.I) GO TO 231
 126           SIG=.5*FJAC*QSAVE(2*J,1)*QSAVE(2*J+1,2)*FFF1(T,S,U)
 127           CALL SIGFIL(SIG,2*J,2*J+1,2*I,2*I+1)
 128           SIG=.5*FJAC*QSAVE(2*J+1,1)*QSAVE(2*J,2)*FFF1(T,S,U)
 129           CALL SIGFIL(SIG,2*J+1,2*J,2*I,2*I+1)
 130 231     CONTINUE
 131         SIG=.5*FJAC*QSAVE(2*I,1)*QSAVE(2*I+1,2)*FFF3(S,T,U)
 132         CALL SIGFIL(SIG,2*I,2*I+1,2*I,2*I+1)
 133         SIG=.5*FJAC*QSAVE(2*I+1,1)*QSAVE(2*I,2)*FFF3(S,U,T)
 134         CALL SIGFIL(SIG,2*I+1,2*I,2*I,2*I+1)
 135 C
 136 235     CONTINUE
 137         IF(.NOT.(GOQ(2*I+1,1).AND.GOQ(2*I,2))) GO TO 230
 138         SIG=.5*FJAC*QSAVE(1,1)*QSAVE(1,2)*FFF5(S,T,U)
 139         CALL SIGFIL(SIG,1,1,2*I+1,2*I)
 140         DO 236 J=1,3
 141           IF(J.EQ.I) GO TO 236
 142           SIG=.5*FJAC*QSAVE(2*J,1)*QSAVE(2*J+1,2)*FFF1(T,S,U)
 143           CALL SIGFIL(SIG,2*J,2*J+1,2*I+1,2*I)
 144           SIG=.5*FJAC*QSAVE(2*J+1,1)*QSAVE(2*J,2)*FFF1(T,S,U)
 145           CALL SIGFIL(SIG,2*J+1,2*J,2*I+1,2*I)
 146 236     CONTINUE
 147         SIG1=.5*FJAC*QSAVE(2*I,1)*QSAVE(2*I+1,2)*FFF3(S,U,T)
 148         CALL SIGFIL(SIG1,2*I,2*I+1,2*I+1,2*I)
 149         SIG=.5*FJAC*QSAVE(2*I+1,1)*QSAVE(2*I,2)*FFF3(S,T,U)
 150         CALL SIGFIL(SIG,2*I+1,2*I,2*I+1,2*I)
 151 230   CONTINUE
 152 C
 153 C          General massless quark-quark
 154       DO 240 I=2,7
 155         DO 241 J=2,7
 156           IF(.NOT.(GOQ(I,1).AND.GOQ(J,2))) GO TO 241
 157           IF((I/2).EQ.(J/2)) GO TO 241
 158           SIG=.5*FJAC*QSAVE(I,1)*QSAVE(J,2)*FFF1(S,T,U)
 159           CALL SIGFIL(SIG,I,J,I,J)
 160           SIG=.5*FJAC*QSAVE(J,1)*QSAVE(I,2)*FFF1(S,U,T)
 161           CALL SIGFIL(SIG,I,J,J,I)
 162 241     CONTINUE
 163 240   CONTINUE
 164 C
 165 C          CH+CB, BT+BB, and TP+TB cross sections.
 166 C          Y=-log(tan(theta/2)), so Jacobean contains P1*P2/E1*E2.
 167 C          Also fourth generation.
 168 C
 169       DO 250 IQ=1,5
 170         IFL=IQ+3
 171         JTYP1=2*IFL
 172         JTYP2=JTYP1+1
 173         IF(.NOT.((GOQ(JTYP1,1).AND.GOQ(JTYP2,2)).OR.
 174      1  (GOQ(JTYP2,1).AND.GOQ(JTYP1,2)))) GO TO 250
 175         AMQ=AMASS(IFL)
 176         IF(AMQ.LT.0.) GO TO 250
 177         AM2=AMQ**2
 178         CALL TWOKIN(0.,0.,AMQ,AMQ)
 179         IF(X(1).GE.1..OR.X(2).GE.1.) GO TO 250
 180         EBT(1)=SQRT(P(1)**2+AM2)
 181         EBT(2)=SQRT(P(2)**2+AM2)
 182         FJACBT=.5*S/SCM*UNITS*P(1)*P(2)/(EBT(1)*EBT(2))
 183         SIG1=12.*(AM2-T)*(AM2-U)/S**2
 184      1  +8./3.*((AM2-T)*(AM2-U)-2.*AM2*(AM2+T))/(AM2-T)**2
 185      2  +8./3.*((AM2-T)*(AM2-U)-2.*AM2*(AM2+U))/(AM2-U)**2
 186      3  -2./3.*AM2*(S-4.*AM2)/((AM2-T)*(AM2-U))
 187      4  -6.*((AM2-T)*(AM2-U)+AM2*(U-T))/(S*(AM2-T))
 188      5  -6.*((AM2-T)*(AM2-U)+AM2*(T-U))/(S*(AM2-U))
 189         SIG1=SIG1*PI**2*ALFQSQ**2/(16.*PI*S**2)
 190         SIG=FJACBT*SIG1*STRUC(X(1),QSQ,1,IDIN(1))/X(1)
 191      1  *STRUC(X(2),QSQ,1,IDIN(2))/X(2)
 192         IF(GOQ(JTYP1,1).AND.GOQ(JTYP2,2))
 193      $  CALL SIGFIL(SIG,1,1,JTYP1,JTYP2)
 194         IF(GOQ(JTYP2,1).AND.GOQ(JTYP1,2))
 195      $  CALL SIGFIL(SIG,1,1,JTYP2,JTYP1)
 196 C
 197         SIG2=((AM2-T)**2+(AM2-U)**2+2.*S*AM2)/S**2
 198         SIG2=FJACBT*SIG2*64.*PI**2*ALFQSQ**2/(9.*16.*PI*S**2)
 199         DO 255 I=1,3
 200           QQ=STRUC(X(1),QSQ,2*I,IDIN(1))*STRUC(X(2),QSQ,2*I+1,IDIN(2))
 201           SIG=SIG2*QQ/(X(1)*X(2))
 202           IF(GOQ(JTYP1,1).AND.GOQ(JTYP2,2))
 203      $    CALL SIGFIL(SIG,2*I,2*I+1,JTYP1,JTYP2)
 204           IF(GOQ(JTYP2,1).AND.GOQ(JTYP1,2))
 205      $    CALL SIGFIL(SIG,2*I,2*I+1,JTYP2,JTYP1)
 206           QQ=STRUC(X(1),QSQ,2*I+1,IDIN(1))*STRUC(X(2),QSQ,2*I,IDIN(2))
 207           SIG=SIG2*QQ/(X(1)*X(2))
 208           IF(GOQ(JTYP1,1).AND.GOQ(JTYP2,2))
 209      $    CALL SIGFIL(SIG,2*I+1,2*I,JTYP1,JTYP2)
 210           IF(GOQ(JTYP2,1).AND.GOQ(JTYP1,2))
 211      $    CALL SIGFIL(SIG,2*I+1,2*I,JTYP2,JTYP1)
 212 255     CONTINUE
 213 250   CONTINUE
 214 C
 215 C          Gluon + heavy quark
 216       DO 300 IQ=8,13.
 217         IF(.NOT.(GOQ(1,1).AND.GOQ(IQ,2))) GO TO 310
 218         AMQ=AMASS(IQ/2)
 219         AM2=AMQ**2
 220         XQMIN=AMQ/ECM
 221         E1=P(1)
 222         E2=SQRT(P(2)**2+AM2)
 223         FJAC=.5*S/SCM*UNITS*PI*ALFQSQ**2/S**2
 224         CALL TWOKIN(0.,AMQ,0.,AMQ)
 225         IF(X(1).LT.1..AND.X(2).LT.1..AND.X(2).GT.XQMIN) THEN
 226           SIG=FJAC*P(1)*P(2)/(E1*E2)*FGQ(S,T,U)*QFCN(1,1)*QFCN(IQ,2)
 227           CALL SIGFIL(SIG,1,IQ,1,IQ)
 228         ENDIF
 229         CALL TWOKIN(AMQ,0.,0.,AMQ)
 230         IF(X(1).LT.1..AND.X(2).LT.1..AND.X(1).GT.XQMIN) THEN
 231           SIG=FJAC*P(1)*P(2)/(E1*E2)*FGQ(S,U,T)*QFCN(IQ,1)*QFCN(1,2)
 232           CALL SIGFIL(SIG,IQ,1,1,IQ)
 233         ENDIF
 234 C
 235 310     IF(.NOT.(GOQ(IQ,1).AND.GOQ(1,2))) GO TO 300
 236         AMQ=AMASS(IQ/2)
 237         AM2=AMQ**2
 238         XQMIN=AMQ/ECM
 239         E1=SQRT(P(1)**2+AM2)
 240         E2=P(2)
 241         FJAC=.5*S/SCM*UNITS*PI*ALFQSQ**2/S**2
 242         CALL TWOKIN(0.,AMQ,AMQ,0.)
 243         IF(X(1).LT.1..AND.X(2).LT.1..AND.X(2).GT.XQMIN) THEN
 244           SIG=FJAC*P(1)*P(2)/(E1*E2)*FGQ(S,U,T)*QFCN(1,1)*QFCN(IQ,2)
 245           CALL SIGFIL(SIG,1,IQ,IQ,1)
 246         ENDIF
 247         CALL TWOKIN(AMQ,0.,AMQ,0.)
 248         IF(X(1).LT.1..AND.X(2).LT.1..AND.X(1).GT.XQMIN) THEN
 249           SIG=FJAC*P(1)*P(2)/(E1*E2)*FGQ(S,T,U)*QFCN(IQ,1)*QFCN(1,2)
 250           CALL SIGFIL(SIG,IQ,1,IQ,1)
 251         ENDIF
 252 300   CONTINUE
 253 C
 254 C          Light quark + heavy quark
 255       DO 320 IQ1=2,7
 256         DO 330 IQ2=8,13
 257           IF(.NOT.(GOQ(IQ1,1).AND.GOQ(IQ2,2))) GO TO 340
 258           AMQ=AMASS(IQ2/2)
 259           AM2=AMQ**2
 260           XQMIN=AMQ/ECM
 261           E1=P(1)
 262           E2=SQRT(P(2)**2+AM2)
 263           FJAC=.5*S/SCM*UNITS*PI*ALFQSQ**2/S**2
 264           CALL TWOKIN(0.,AMQ,0.,AMQ)
 265           IF(X(1).LT.1..AND.X(2).LT.1..AND.X(2).GT.XQMIN) THEN
 266             SIG=FJAC*P(1)*P(2)/(E1*E2)*FQQ(S,T,U)*QFCN(IQ1,1)
 267      $      *QFCN(IQ2,2)
 268             CALL SIGFIL(SIG,IQ1,IQ2,IQ1,IQ2)
 269           ENDIF
 270           CALL TWOKIN(AMQ,0.,0.,AMQ)
 271           IF(X(1).LT.1..AND.X(2).LT.1..AND.X(1).GT.XQMIN) THEN
 272             SIG=FJAC*P(1)*P(2)/(E1*E2)*FQQ(S,U,T)*QFCN(IQ1,2)
 273      $      *QFCN(IQ2,1)
 274             CALL SIGFIL(SIG,IQ2,IQ1,IQ1,IQ2)
 275           ENDIF
 276 C
 277 340       IF(.NOT.(GOQ(IQ1,2).AND.GOQ(IQ2,1))) GO TO 330
 278           AMQ=AMASS(IQ2/2)
 279           AM2=AMQ**2
 280           XQMIN=AMQ/ECM
 281           E1=SQRT(P(1)**2+AM2)
 282           E2=P(2)
 283           FJAC=.5*S/SCM*UNITS*PI*ALFQSQ**2/S**2
 284           CALL TWOKIN(0.,AMQ,AMQ,0.)
 285           IF(X(1).LT.1..AND.X(2).LT.1..AND.X(2).GT.XQMIN) THEN
 286             SIG=FJAC*P(1)*P(2)/(E1*E2)*FQQ(S,U,T)*QFCN(IQ1,1)
 287      $      *QFCN(IQ2,2)
 288             CALL SIGFIL(SIG,IQ1,IQ2,IQ2,IQ1)
 289           ENDIF
 290           CALL TWOKIN(AMQ,0.,AMQ,0.)
 291           IF(X(1).LT.1..AND.X(2).LT.1..AND.X(1).GT.XQMIN) THEN
 292             SIG=FJAC*P(1)*P(2)/(E1*E2)*FQQ(S,T,U)*QFCN(IQ1,2)
 293      $      *QFCN(IQ2,1)
 294             CALL SIGFIL(SIG,IQ2,IQ1,IQ2,IQ1)
 295           ENDIF
 296 330     CONTINUE
 297 320   CONTINUE
 298 C
 299       RETURN
 300       END