ISAJET/code/sigkkg.F

   1 #include "isajet/pilot.h"
   2       SUBROUTINE SIGKKG
   3 C
   4 C          Compute the KK graviton direct production cross-section
   5 C          d(sigma)/d(m**2)d(pT**2)d(y3)d(y4)
   6 C          X-sections: G.F.Giudice et al.  hep-ph/9811291
   7 C          Kinematics: sigdy.car (Drell-Yan + jet)
   8 C
   9 #if defined(CERNLIB_IMPNONE)
  10       IMPLICIT NONE
  11 #endif
  12 C
  13 #include "isajet/itapes.inc"
  14 #include "isajet/qcdpar.inc"
  15 #include "isajet/jetpar.inc"
  16 #include "isajet/primar.inc"
  17 #include "isajet/q1q2.inc"
  18 #include "isajet/jetsig.inc"
  19 #include "isajet/qsave.inc"
  20 #include "isajet/wcon.inc"
  21 #include "isajet/const.inc"
  22 #include "isajet/nodcay.inc"
  23 #include "isajet/kkgrav.inc"
  24 C
  25       REAL X(2)
  26       REAL Z,S,T,U,QMW2,QZW,EHAT,Q2SAVE,YHAT,EY,P3Z,P1,P2,AMASS,ANEFF,
  27      $SIG0,DENOM,QT2CUT,SIGT,SIGU,FAC,PROP,FACTOR,SIG,AMT,AMT2,SWT,
  28      $P1WT,P2WT,X1WT,X2WT,TWT,UWT,Q2,QFCN,STRUC,XX,ACOSH,ATANH,P2M,P1M
  29       REAL AMI2,AMF2,EFWT
  30       REAL AJLWT,AJLZT1,AJLZT2,A2,A2B2,QQ,TM2
  31       INTEGER I,IQ,IH,IQ1,IFL,IQ2,IW,IQ3
  32       INTEGER NZERO(4)
  33       REAL AMFAC(13)
  34       INTEGER NUTYP(25)
  35       INTEGER IFL1,IFL2
  36       REAL TERM
  37       REAL KKGF1,KKGF2,KKGF3,SIG1,SIG2,XG,YG,F1,F2T,F2U,F3
  38       EQUIVALENCE (S,SHAT),(T,THAT),(U,UHAT),(X(1),X1)
  39 C          Electric charge:
  40       REAL CHARGE
  41       EXTERNAL CHARGE
  42 C
  43 C          Kinematics: (Drell-Yan plus jet)
  44 C
  45       QMW2=QMW**2
  46       QTMW=SQRT(QMW2+QTW**2)
  47       Q0W=QTMW*COSH(YW)
  48       QZW=QTMW*SINH(YW)
  49       QW=SQRT(QZW**2+QTW**2)
  50 C          Protect against errors
  51       IF(QW.NE.0.) THEN
  52         CTHW=QZW/QW
  53         STHW=QTW/QW
  54         IF(ABS(CTHW).LT.1.) THEN
  55           THW=ACOS(CTHW)
  56         ELSE
  57           CTHW=0.
  58           STHW=1.
  59           THW=.5*PI
  60         ENDIF
  61       ELSE
  62         CTHW=0.
  63         STHW=1.
  64         THW=.5*PI
  65       ENDIF
  66 c          Drell-Yan plus jet
  67       P3Z=P(3)*CTH(3)
  68       SHAT=QMW2+2.*Q0W*P(3)-2.*QZW*P3Z+2.*PT(3)**2
  69       P1=.5*(P(3)+P3Z+Q0W+QZW)
  70       P2=.5*(P(3)-P3Z+Q0W-QZW)
  71       X1=P1/HALFE
  72       X2=P2/HALFE
  73       THAT=-2.*P1*(P(3)-P3Z)
  74       UHAT=-2.*P2*(P(3)+P3Z)
  75       QSQ=QTW**2
  76       QSQ=AMAX1(QSQ,4.)
  77       ANEFF=4.+QSQ/(QSQ+AMASS(5)**2)+QSQ/(QSQ+AMASS(6)**2)
  78       ALFQSQ=12.*PI/((33.-2.*ANEFF)*ALOG(QSQ/ALAM2))
  79       Q2SAVE=QSQ
  80       QSQ=SHAT
  81 C
  82 C          Initialize
  83 C
  84       SIGMA=0.
  85       NSIGS=0
  86       DO 100 I=1,MXSIGS
  87         SIGS(I)=0.
  88 100   CONTINUE
  89       IF(X1.GE.1..OR.X2.GE.1.) RETURN
  90 C
  91 C          Structure functions
  92 C
  93       DO 110 IH=1,2
  94         DO 120 IQ=1,11
  95           QSAVE(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH)
  96 120     CONTINUE
  97         QSAVE(12,IH)=0
  98         QSAVE(13,IH)=0
  99 110   CONTINUE
 100       QSQ=Q2SAVE
 101 C
 102       IF((THAT/SHAT).EQ.0.) RETURN
 103       IF(ABS(THAT/SHAT+1).LT.1.E-06) RETURN
 104       F1=KKGF1(SHAT,THAT,QMW2)
 105       F2T=KKGF2(SHAT,THAT,QMW2)
 106       F2U=KKGF2(SHAT,UHAT,QMW2)
 107       F3=KKGF3(SHAT,THAT,QMW2)
 108       IF(F1.LE.0.OR.F2T.LE.0.OR.F2U.LE.0.OR.F3.LE.0) RETURN
 109 C
 110       SIG0=UNITS*0.5*KKGSD*ALFQSQ*QMW**(NEXTRAD-2)/SCM
 111 C
 112 C          Jet 3 = gamma:
 113 C
 114       IF(GOQ(26,3)) THEN
 115         SIG1=UNITS*0.5*KKGSD*ALFA*QMW**(NEXTRAD-2)/SCM
 116         SIG1=SIG1*F1/48.0
 117 C          qk + qb --> gamma + KKG
 118         DO 410 IFL=1,5
 119           IQ1=2*IFL
 120           IQ2=IQ1+1
 121           SIG2=SIG1*ABS(CHARGE(IFL))
 122           SIG=SIG2*QSAVE(IQ1,1)*QSAVE(IQ2,2)
 123           IF(UVCUT.AND.SHAT.GE.(MASSD**2)) SIG=SIG*(MASSD**2/SHAT)**2
 124           CALL SIGFIL(SIG,IQ1,IQ2,5,26)
 125           SIG=SIG2*QSAVE(IQ2,1)*QSAVE(IQ1,2)
 126           IF(UVCUT.AND.SHAT.GE.(MASSD**2)) SIG=SIG*(MASSD**2/SHAT)**2
 127           CALL SIGFIL(SIG,IQ2,IQ1,5,26)
 128 410     CONTINUE
 129       ENDIF
 130 C
 131 C          Jet 3 = gluon:
 132 C
 133       IF(GOQ(1,3)) THEN
 134         SIG1=SIG0*F1/36.0
 135 C          qk + qb --> gl + KKG
 136         DO 210 IFL=1,5
 137           IQ1=2*IFL
 138           IQ2=IQ1+1
 139           SIG=SIG1*QSAVE(IQ1,1)*QSAVE(IQ2,2)
 140           IF(UVCUT.AND.SHAT.GE.(MASSD**2)) SIG=SIG*(MASSD**2/SHAT)**2
 141           CALL SIGFIL(SIG,IQ1,IQ2,5,1)
 142           SIG=SIG1*QSAVE(IQ2,1)*QSAVE(IQ1,2)
 143           IF(UVCUT.AND.SHAT.GE.(MASSD**2)) SIG=SIG*(MASSD**2/SHAT)**2
 144           CALL SIGFIL(SIG,IQ1,IQ1,5,1)
 145 210     CONTINUE
 146 C          gl + gl --> gl + KKG
 147         SIG1=SIG0*F3*3.0/16.0
 148         SIG=SIG1*QSAVE(1,1)*QSAVE(1,2)
 149           IF(UVCUT.AND.SHAT.GE.(MASSD**2)) SIG=SIG*(MASSD**2/SHAT)**2
 150         CALL SIGFIL(SIG,1,1,5,1)
 151       ENDIF
 152 C
 153 C          Jet 3 = quark:
 154 C
 155       SIGT=SIG0*F2T/96.0
 156       SIGU=SIG0*F2U/96.0
 157 C          qk + gl --> qk + KKG
 158       DO 310 IQ1=2,11
 159         IQ3=IQ1
 160         IF(GOQ(IQ3,3)) THEN
 161           SIG=SIGU*QSAVE(IQ1,1)*QSAVE(1,2)
 162           IF(UVCUT.AND.SHAT.GE.(MASSD**2)) SIG=SIG*(MASSD**2/SHAT)**2
 163           CALL SIGFIL(SIG,IQ1,1,5,IQ3)
 164           SIG=SIGT*QSAVE(IQ1,2)*QSAVE(1,1)
 165           IF(UVCUT.AND.SHAT.GE.(MASSD**2)) SIG=SIG*(MASSD**2/SHAT)**2
 166           CALL SIGFIL(SIG,1,IQ1,5,IQ3)
 167         ENDIF
 168 310   CONTINUE
 169 C
 170       RETURN
 171       END