]>
Commit | Line | Data |
---|---|---|
0795afa3 | 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 |