ISAJET/code/siggam.F

   1 #include "isajet/pilot.h"
   2       SUBROUTINE SIGGAM
   3 C
   4 C          Compute D(SIGMA)/D(PT**2)D(Y1)D(Y2) for gamma + jet and
   5 C          gamma + gamma.
   6 C
   7 C          SIGMA    = cross section summed over quark types allowed by
   8 C                     JETTYPE card.
   9 C          SIGS(I)  = partial cross section for I1 + I2 --> I3 + I4.
  10 C          INOUT(I) = IOPAK**3*I4 + IOPAK**2*I3 + IOPAK*I2 + I1
  11 C                     using JETTYPE code.
  12 C
  13 C          Cross sections from Berger, Bratten, and Field, Nucl. Phys.
  14 C          B239, 52 (1984), Table 2. Masses are neglected.
  15 C
  16 C
  17 #if defined(CERNLIB_IMPNONE)
  18       IMPLICIT NONE
  19 #endif
  20 #include "isajet/itapes.inc"
  21 #include "isajet/qcdpar.inc"
  22 #include "isajet/jetpar.inc"
  23 #include "isajet/primar.inc"
  24 #include "isajet/q1q2.inc"
  25 #include "isajet/jetsig.inc"
  26 #include "isajet/const.inc"
  27 #include "isajet/wcon.inc"
  28 C
  29       REAL BBF1,BBF2,BBF3,S,T,U,FJAC,STRUC,SIG0,SIG,BBF3TU,BBF3UT
  30       INTEGER I,IH,IQ,IFL
  31       REAL X(2),QSAVE(13,2)
  32       INTEGER LISTJ(13)
  33       EQUIVALENCE (X(1),X1),(S,SHAT),(T,THAT),(U,UHAT)
  34       DATA LISTJ/9,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6/
  35 C
  36 C          Cross sections with couplings and Jacobean removed.
  37       BBF1(S,T,U)=8./9.*(U/T+T/U)
  38       BBF2(S,T,U)=2./3.*(U/T+T/U)
  39       BBF3(S,T,U)=-1./3.*(U/S+S/U)
  40 C
  41 C          Initialize cross sections.
  42 C
  43       SIGMA=0.
  44       NSIGS=0
  45       DO 100 I=1,MXSIGS
  46       SIGS(I)=0.
  47 100   CONTINUE
  48 C
  49 C          Kinematics and structure functions for CH and lighter quarks
  50 C
  51       CALL TWOKIN(0.,0.,0.,0.)
  52       FJAC=SHAT/SCM*UNITS*PI/SHAT**2
  53       IF(X1.GE.1.0.OR.X2.GE.1.0) RETURN
  54       DO 110 IH=1,2
  55       DO 110 IQ=1,9
  56         QSAVE(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH)
  57 110   CONTINUE
  58 C
  59 C          Compute cross sections summed over all types allowed by
  60 C          JETTYPE card.
  61 C
  62       IF(.NOT.(GOQ(26,1).OR.GOQ(26,2))) RETURN
  63 C
  64 C          Gluon-photon
  65 C
  66       IF((GOQ(1,1).AND.GOQ(26,2)).OR.(GOQ(26,1).AND.GOQ(1,2))) THEN
  67         SIG0=.5*FJAC*ALFQSQ*ALFA*BBF1(S,T,U)
  68         DO 210 I=1,4
  69           IFL=LISTJ(2*I)
  70           SIG=SIG0*AQ(IFL,1)**2*QSAVE(2*I,1)*QSAVE(2*I+1,2)
  71           IF(GOQ(26,1).AND.GOQ(1,2)) CALL SIGFIL(SIG,2*I,2*I+1,26,1)
  72           IF(GOQ(1,1).AND.GOQ(26,2)) CALL SIGFIL(SIG,2*I,2*I+1,1,26)
  73           SIG=SIG0*AQ(IFL,1)**2*QSAVE(2*I+1,1)*QSAVE(2*I,2)
  74           IF(GOQ(26,1).AND.GOQ(1,2)) CALL SIGFIL(SIG,2*I+1,2*I,26,1)
  75           IF(GOQ(1,1).AND.GOQ(26,2)) CALL SIGFIL(SIG,2*I+1,2*I,1,26)
  76 210     CONTINUE
  77       ENDIF
  78 C
  79 C          Photon-photon
  80 C
  81       IF(GOQ(26,1).AND.GOQ(26,2)) THEN
  82         SIG0=.5*FJAC*ALFA**2*BBF2(S,T,U)
  83         DO 220 I=1,4
  84           IFL=LISTJ(2*I)
  85           SIG=SIG0*AQ(IFL,1)**4*QSAVE(2*I,1)*QSAVE(2*I+1,2)
  86           CALL SIGFIL(SIG,2*I,2*I+1,26,26)
  87           SIG=SIG0*AQ(IFL,1)**4*QSAVE(2*I+1,1)*QSAVE(2*I,2)
  88           CALL SIGFIL(SIG,2*I+1,2*I,26,26)
  89 220     CONTINUE
  90       ENDIF
  91 C
  92 C          Quark-photon
  93 C
  94       BBF3TU=.5*FJAC*ALFA*ALFQSQ*BBF3(S,T,U)
  95       BBF3UT=.5*FJAC*ALFA*ALFQSQ*BBF3(S,U,T)
  96       DO 230 I=2,9
  97         IFL=IABS(LISTJ(I))
  98         IF(GOQ(26,1).AND.GOQ(I,2)) THEN
  99           SIG=BBF3TU*AQ(IFL,1)**2*QSAVE(I,1)*QSAVE(1,2)
 100           CALL SIGFIL(SIG,I,1,26,I)
 101           SIG=BBF3UT*AQ(IFL,1)**2*QSAVE(1,1)*QSAVE(I,2)
 102           CALL SIGFIL(SIG,1,I,26,I)
 103         ENDIF
 104         IF(GOQ(I,1).AND.GOQ(26,2)) THEN
 105           SIG=BBF3UT*AQ(IFL,1)**2*QSAVE(I,1)*QSAVE(1,2)
 106           CALL SIGFIL(SIG,I,1,I,26)
 107           SIG=BBF3TU*AQ(IFL,1)**2*QSAVE(1,1)*QSAVE(I,2)
 108           CALL SIGFIL(SIG,1,I,I,26)
 109         ENDIF
 110 230   CONTINUE
 111 C
 112       RETURN
 113       END