pythiaeRHIC/pythia/pysgqc.f

0001
0002 C*********************************************************************
0003
0004 C...PYSGQC
0005 C...Subprocess cross sections for QCD processes,
0006 C...including photons.
0007 C...Auxiliary to PYSIGH.
0008
0009       SUBROUTINE PYSGQC(NCHN,SIGS)
0010
0011 C...Double precision and integer declarations
0012       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0013       IMPLICIT INTEGER(I-N)
0014       INTEGER PYK,PYCHGE,PYCOMP
0015 C...Parameter statement to help give large particle numbers.
0016       PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000,
0017      &KEXCIT=4000000,KDIMEN=5000000)
0018 C...Commonblocks
0019       COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0020       COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
0021       COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5)
0022       COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
0023       COMMON/PYINT1/MINT(400),VINT(400)
0024       COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2)
0025       COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000)
0026       COMMON/PYINT4/MWID(500),WIDS(500,5)
0027       COMMON/PYINT7/SIGT(0:6,0:6,0:5)
0028       COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA,
0029      &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4,
0030      &SHR,SQPTH,TAUP,BE34,CTH,X(2),SQMZ,SQMW,GMMZ,GMMW,
0031      &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR
0032       SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYPARS/,/PYINT1/,/PYINT2/,
0033      &/PYINT3/,/PYINT4/,/PYINT7/,/PYSGCM/
0034 C...Local arrays
0035       DIMENSION WDTP(0:400),WDTE(0:400,0:5)
0036
0037 C...Differential cross section expressions.
0038
0039       IF(ISUB.LE.20) THEN
0040         IF(ISUB.EQ.10) THEN
0041 C...f + f' -> f + f' (gamma/Z/W exchange)
0042           FACGGF=COMFAC*AEM**2*2D0*(SH2+UH2)/TH2
0043           FACGZF=COMFAC*AEM**2*XWC*4D0*SH2/(TH*(TH-SQMZ))
0044           FACZZF=COMFAC*(AEM*XWC)**2*2D0*SH2/(TH-SQMZ)**2
0045           FACWWF=COMFAC*(0.5D0*AEM/XW)**2*SH2/(TH-SQMW)**2
0046           DO 110 I=MMIN1,MMAX1
0047             IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 110
0048             IA=IABS(I)
0049             DO 100 J=MMIN2,MMAX2
0050               IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 100
0051               JA=IABS(J)
0052 C...Electroweak couplings
0053               EI=KCHG(IA,1)*ISIGN(1,I)/3D0
0054               AI=SIGN(1D0,KCHG(IA,1)+0.5D0)*ISIGN(1,I)
0055               VI=AI-4D0*EI*XWV
0056               EJ=KCHG(JA,1)*ISIGN(1,J)/3D0
0057               AJ=SIGN(1D0,KCHG(JA,1)+0.5D0)*ISIGN(1,J)
0058               VJ=AJ-4D0*EJ*XWV
0059               EPSIJ=ISIGN(1,I*J)
0060 C...gamma/Z exchange, only gamma exchange, or only Z exchange
0061               IF(MSTP(21).GE.1.AND.MSTP(21).LE.4) THEN
0062                 IF(MSTP(21).EQ.1.OR.MSTP(21).EQ.4) THEN
0063                   FACNCF=FACGGF*EI**2*EJ**2+FACGZF*EI*EJ*
0064      &            (VI*VJ*(1D0+UH2/SH2)+AI*AJ*EPSIJ*(1D0-UH2/SH2))+
0065      &            FACZZF*((VI**2+AI**2)*(VJ**2+AJ**2)*(1D0+UH2/SH2)+
0066      &            4D0*VI*VJ*AI*AJ*EPSIJ*(1D0-UH2/SH2))
0067                 ELSEIF(MSTP(21).EQ.2) THEN
0068                   FACNCF=FACGGF*EI**2*EJ**2
0069                 ELSE
0070                   FACNCF=FACZZF*((VI**2+AI**2)*(VJ**2+AJ**2)*
0071      &            (1D0+UH2/SH2)+4D0*VI*VJ*AI*AJ*EPSIJ*(1D0-UH2/SH2))
0072                 ENDIF
0073 C...Extrafactor 2 for only one incoming neutrino spin state.
0074                 IF(IA.GT.10.AND.MOD(IA,2).EQ.0) FACNCF=2D0*FACNCF
0075                 IF(JA.GT.10.AND.MOD(JA,2).EQ.0) FACNCF=2D0*FACNCF
0076                 NCHN=NCHN+1
0077                 ISIG(NCHN,1)=I
0078                 ISIG(NCHN,2)=J
0079                 ISIG(NCHN,3)=1
0080                 SIGH(NCHN)=FACNCF
0081               ENDIF
0082 C...W exchange
0083               IF((MSTP(21).EQ.1.OR.MSTP(21).EQ.5).AND.AI*AJ.LT.0D0) THEN
0084                 FACCCF=FACWWF*VINT(180+I)*VINT(180+J)
0085                 IF(EPSIJ.LT.0D0) FACCCF=FACCCF*UH2/SH2
0086                 IF(IA.GT.10.AND.MOD(IA,2).EQ.0) FACCCF=2D0*FACCCF
0087                 IF(JA.GT.10.AND.MOD(JA,2).EQ.0) FACCCF=2D0*FACCCF
0088                 NCHN=NCHN+1
0089                 ISIG(NCHN,1)=I
0090                 ISIG(NCHN,2)=J
0091                 ISIG(NCHN,3)=2
0092                 SIGH(NCHN)=FACCCF
0093               ENDIF
0094   100       CONTINUE
0095   110     CONTINUE
0096
0097         ELSEIF(ISUB.EQ.11) THEN
0098 C...f + f' -> f + f' (g exchange)
0099           FACQQ1=COMFAC*AS**2*4D0/9D0*(SH2+UH2)/TH2
0100           FACQQB=COMFAC*AS**2*4D0/9D0*((SH2+UH2)/TH2*FACA-
0101      &    MSTP(34)*2D0/3D0*UH2/(SH*TH))
0102           FACQQ2=COMFAC*AS**2*4D0/9D0*((SH2+TH2)/UH2-
0103      &    MSTP(34)*2D0/3D0*SH2/(TH*UH))
0104           DO 130 I=MMIN1,MMAX1
0105             IA=IABS(I)
0106             IF(I.EQ.0.OR.IA.GT.MSTP(58).OR.KFAC(1,I).EQ.0) GOTO 130
0107             DO 120 J=MMIN2,MMAX2
0108               JA=IABS(J)
0109               IF(J.EQ.0.OR.JA.GT.MSTP(58).OR.KFAC(2,J).EQ.0) GOTO 120
0110               NCHN=NCHN+1
0111               ISIG(NCHN,1)=I
0112               ISIG(NCHN,2)=J
0113               ISIG(NCHN,3)=1
0114               SIGH(NCHN)=FACQQ1
0115               IF(I.EQ.-J) SIGH(NCHN)=FACQQB
0116               IF(I.EQ.J) THEN
0117                 SIGH(NCHN)=0.5D0*SIGH(NCHN)
0118                 NCHN=NCHN+1
0119                 ISIG(NCHN,1)=I
0120                 ISIG(NCHN,2)=J
0121                 ISIG(NCHN,3)=2
0122                 SIGH(NCHN)=0.5D0*FACQQ2
0123               ENDIF
0124   120       CONTINUE
0125   130     CONTINUE
0126
0127         ELSEIF(ISUB.EQ.12) THEN
0128 C...f + fbar -> f' + fbar' (q + qbar -> q' + qbar' only)
0129           CALL PYWIDT(21,SH,WDTP,WDTE)
0130           FACQQB=COMFAC*AS**2*4D0/9D0*(TH2+UH2)/SH2*
0131      &    (WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
0132           DO 140 I=MMINA,MMAXA
0133             IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
0134      &      KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 140
0135             NCHN=NCHN+1
0136             ISIG(NCHN,1)=I
0137             ISIG(NCHN,2)=-I
0138             ISIG(NCHN,3)=1
0139             SIGH(NCHN)=FACQQB
0140   140     CONTINUE
0141
0142         ELSEIF(ISUB.EQ.13) THEN
0143 C...f + fbar -> g + g (q + qbar -> g + g only)
0144           FACGG1=COMFAC*AS**2*32D0/27D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)*
0145      &    UH2/SH2)
0146           FACGG2=COMFAC*AS**2*32D0/27D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)*
0147      &    TH2/SH2)
0148           DO 150 I=MMINA,MMAXA
0149             IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
0150      &      KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 150
0151             NCHN=NCHN+1
0152             ISIG(NCHN,1)=I
0153             ISIG(NCHN,2)=-I
0154             ISIG(NCHN,3)=1
0155             SIGH(NCHN)=0.5D0*FACGG1
0156             NCHN=NCHN+1
0157             ISIG(NCHN,1)=I
0158             ISIG(NCHN,2)=-I
0159             ISIG(NCHN,3)=2
0160             SIGH(NCHN)=0.5D0*FACGG2
0161   150     CONTINUE
0162
0163         ELSEIF(ISUB.EQ.14) THEN
0164 C...f + fbar -> g + gamma (q + qbar -> g + gamma only)
0165           FACGG=COMFAC*AS*AEM*8D0/9D0*(TH2+UH2)/(TH*UH)
0166           DO 160 I=MMINA,MMAXA
0167             IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
0168      &      KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 160
0169             EI=KCHG(IABS(I),1)/3D0
0170             NCHN=NCHN+1
0171             ISIG(NCHN,1)=I
0172             ISIG(NCHN,2)=-I
0173             ISIG(NCHN,3)=1
0174             SIGH(NCHN)=FACGG*EI**2
0175   160     CONTINUE
0176
0177         ELSEIF(ISUB.EQ.18) THEN
0178 C...f + fbar -> gamma + gamma
0179           FACGG=COMFAC*AEM**2*2D0*(TH2+UH2)/(TH*UH)
0180           DO 170 I=MMINA,MMAXA
0181             IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 170
0182             EI=KCHG(IABS(I),1)/3D0
0183             FCOI=1D0
0184             IF(IABS(I).LE.10) FCOI=FACA/3D0
0185             NCHN=NCHN+1
0186             ISIG(NCHN,1)=I
0187             ISIG(NCHN,2)=-I
0188             ISIG(NCHN,3)=1
0189             SIGH(NCHN)=0.5D0*FACGG*FCOI*EI**4
0190   170     CONTINUE
0191         ENDIF
0192
0193       ELSEIF(ISUB.LE.40) THEN
0194         IF(ISUB.EQ.28) THEN
0195 C...f + g -> f + g (q + g -> q + g only)
0196           FACQG1=COMFAC*AS**2*4D0/9D0*((2D0+MSTP(34)*1D0/4D0)*UH2/TH2-
0197      &    UH/SH)*FACA
0198           FACQG2=COMFAC*AS**2*4D0/9D0*((2D0+MSTP(34)*1D0/4D0)*SH2/TH2-
0199      &    SH/UH)
0200           DO 190 I=MMINA,MMAXA
0201             IF(I.EQ.0.OR.IABS(I).GT.10) GOTO 190
0202             DO 180 ISDE=1,2
0203               IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 180
0204               IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 180
0205               NCHN=NCHN+1
0206               ISIG(NCHN,ISDE)=I
0207               ISIG(NCHN,3-ISDE)=21
0208               ISIG(NCHN,3)=1
0209               SIGH(NCHN)=FACQG1
0210               NCHN=NCHN+1
0211               ISIG(NCHN,ISDE)=I
0212               ISIG(NCHN,3-ISDE)=21
0213               ISIG(NCHN,3)=2
0214               SIGH(NCHN)=FACQG2
0215   180       CONTINUE
0216   190     CONTINUE
0217
0218         ELSEIF(ISUB.EQ.29) THEN
0219 C...f + g -> f + gamma (q + g -> q + gamma only)
0220           FGQ=COMFAC*FACA*AS*AEM*1D0/3D0*(SH2+UH2)/(-SH*UH)
0221           DO 210 I=MMINA,MMAXA
0222             IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 210
0223             EI=KCHG(IABS(I),1)/3D0
0224             FACGQ=FGQ*EI**2
0225             DO 200 ISDE=1,2
0226               IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 200
0227               IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 200
0228               NCHN=NCHN+1
0229               ISIG(NCHN,ISDE)=I
0230               ISIG(NCHN,3-ISDE)=21
0231               ISIG(NCHN,3)=1
0232               SIGH(NCHN)=FACGQ
0233   200       CONTINUE
0234   210     CONTINUE
0235
0236         ELSEIF(ISUB.EQ.33) THEN
0237 C...f + gamma -> f + g (q + gamma -> q + g only)
0238           FGQ=COMFAC*AS*AEM*8D0/3D0*(SH2+UH2)/(-SH*UH)
0239           DO 230 I=MMINA,MMAXA
0240             IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 230
0241             EI=KCHG(IABS(I),1)/3D0
0242             FACGQ=FGQ*EI**2
0243             DO 220 ISDE=1,2
0244               IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 220
0245               IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 220
0246               NCHN=NCHN+1
0247               ISIG(NCHN,ISDE)=I
0248               ISIG(NCHN,3-ISDE)=22
0249               ISIG(NCHN,3)=1
0250               SIGH(NCHN)=FACGQ
0251   220       CONTINUE
0252   230     CONTINUE
0253
0254         ELSEIF(ISUB.EQ.34) THEN
0255 C...f + gamma -> f + gamma
0256           FGQ=COMFAC*AEM**2*2D0*(SH2+UH2)/(-SH*UH)
0257           DO 250 I=MMINA,MMAXA
0258             IF(I.EQ.0) GOTO 250
0259             EI=KCHG(IABS(I),1)/3D0
0260             FACGQ=FGQ*EI**4
0261             DO 240 ISDE=1,2
0262               IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 240
0263               IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 240
0264               NCHN=NCHN+1
0265               ISIG(NCHN,ISDE)=I
0266               ISIG(NCHN,3-ISDE)=22
0267               ISIG(NCHN,3)=1
0268               SIGH(NCHN)=FACGQ
0269   240       CONTINUE
0270   250     CONTINUE
0271         ENDIF
0272
0273       ELSEIF(ISUB.LE.80) THEN
0274         IF(ISUB.EQ.53) THEN
0275 C...g + g -> f + fbar (g + g -> q + qbar only)
0276           IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 270
0277           IDC0=MDCY(21,2)-1
0278 C...Begin by d, u, s flavours.
0279           FLAVWT=0D0
0280           IF(MDME(IDC0+1,1).GE.1) FLAVWT=FLAVWT+
0281      &    SQRT(MAX(0D0,1D0-4D0*PMAS(1,1)**2/SH))
0282           IF(MDME(IDC0+2,1).GE.1) FLAVWT=FLAVWT+
0283      &    SQRT(MAX(0D0,1D0-4D0*PMAS(2,1)**2/SH))
0284           IF(MDME(IDC0+3,1).GE.1) FLAVWT=FLAVWT+
0285      &    SQRT(MAX(0D0,1D0-4D0*PMAS(3,1)**2/SH))
0286           FACQQ1=COMFAC*AS**2*1D0/6D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)*
0287      &    UH2/SH2)*FLAVWT*FACA
0288           FACQQ2=COMFAC*AS**2*1D0/6D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)*
0289      &    TH2/SH2)*FLAVWT*FACA
0290           NCHN=NCHN+1
0291           ISIG(NCHN,1)=21
0292           ISIG(NCHN,2)=21
0293           ISIG(NCHN,3)=1
0294           SIGH(NCHN)=FACQQ1
0295           NCHN=NCHN+1
0296           ISIG(NCHN,1)=21
0297           ISIG(NCHN,2)=21
0298           ISIG(NCHN,3)=2
0299           SIGH(NCHN)=FACQQ2
0300 C...Next c and b flavours: modified that and uhat for fixed
0301 C...cos(theta-hat).
0302           DO 260 IFL=4,5
0303           SQMAVG=PMAS(IFL,1)**2
0304           IF(MDME(IDC0+IFL,1).GE.1.AND.SH.GT.4.04D0*SQMAVG) THEN
0305             BE34=SQRT(1D0-4D0*SQMAVG/SH)
0306             THQ=-0.5D0*SH*(1D0-BE34*CTH)
0307             UHQ=-0.5D0*SH*(1D0+BE34*CTH)
0308             THUHQ=THQ*UHQ-SQMAVG*SH
0309             IF(MSTP(34).EQ.0) THEN
0310               FACQQ1=UHQ/THQ-2D0*UHQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/THQ**2
0311               FACQQ2=THQ/UHQ-2D0*THQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/UHQ**2
0312             ELSE
0313               FACQQ1=UHQ/THQ-2.25D0*UHQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/
0314      &        THQ**2+0.5D0*SQMAVG*(THQ+SQMAVG)/THQ**2-SQMAVG**2/(SH*THQ)
0315               FACQQ2=THQ/UHQ-2.25D0*THQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/
0316      &        UHQ**2+0.5D0*SQMAVG*(UHQ+SQMAVG)/UHQ**2-SQMAVG**2/(SH*UHQ)
0317             ENDIF
0318             FACQQ1=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ1*BE34
0319             FACQQ2=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ2*BE34
0320             NCHN=NCHN+1
0321             ISIG(NCHN,1)=21
0322             ISIG(NCHN,2)=21
0323             ISIG(NCHN,3)=1+2*(IFL-3)
0324             SIGH(NCHN)=FACQQ1
0325             NCHN=NCHN+1
0326             ISIG(NCHN,1)=21
0327             ISIG(NCHN,2)=21
0328             ISIG(NCHN,3)=2+2*(IFL-3)
0329             SIGH(NCHN)=FACQQ2
0330           ENDIF
0331   260     CONTINUE
0332   270     CONTINUE
0333
0334         ELSEIF(ISUB.EQ.54) THEN
0335 C...g + gamma -> f + fbar (g + gamma -> q + qbar only)
0336           CALL PYWIDT(21,SH,WDTP,WDTE)
0337           WDTESU=0D0
0338           DO 280 I=1,MIN(8,MDCY(21,3))
0339             EF=KCHG(I,1)/3D0
0340             WDTESU=WDTESU+EF**2*(WDTE(I,1)+WDTE(I,2)+WDTE(I,3)+
0341      &      WDTE(I,4))
0342   280     CONTINUE
0343           FACQQ=COMFAC*AEM*AS*WDTESU*(TH2+UH2)/(TH*UH)
0344           IF(KFAC(1,21)*KFAC(2,22).NE.0) THEN
0345             NCHN=NCHN+1
0346             ISIG(NCHN,1)=21
0347             ISIG(NCHN,2)=22
0348             ISIG(NCHN,3)=1
0349             SIGH(NCHN)=FACQQ
0350           ENDIF
0351           IF(KFAC(1,22)*KFAC(2,21).NE.0) THEN
0352             NCHN=NCHN+1
0353             ISIG(NCHN,1)=22
0354             ISIG(NCHN,2)=21
0355             ISIG(NCHN,3)=1
0356             SIGH(NCHN)=FACQQ
0357           ENDIF
0358
0359         ELSEIF(ISUB.EQ.58) THEN
0360 C...gamma + gamma -> f + fbar
0361           CALL PYWIDT(22,SH,WDTP,WDTE)
0362           WDTESU=0D0
0363           DO 290 I=1,MIN(12,MDCY(22,3))
0364             IF(I.LE.8) EF= KCHG(I,1)/3D0
0365             IF(I.GE.9) EF= KCHG(9+2*(I-8),1)/3D0
0366             WDTESU=WDTESU+EF**2*(WDTE(I,1)+WDTE(I,2)+WDTE(I,3)+
0367      &      WDTE(I,4))
0368   290     CONTINUE
0369           FACFF=COMFAC*AEM**2*WDTESU*2D0*(TH2+UH2)/(TH*UH)
0370           IF(KFAC(1,22)*KFAC(2,22).NE.0) THEN
0371             NCHN=NCHN+1
0372             ISIG(NCHN,1)=22
0373             ISIG(NCHN,2)=22
0374             ISIG(NCHN,3)=1
0375             SIGH(NCHN)=FACFF
0376           ENDIF
0377
0378         ELSEIF(ISUB.EQ.68) THEN
0379 C...g + g -> g + g
0380           IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 300
0381           FACGG1=COMFAC*AS**2*9D0/4D0*(SH2/TH2+2D0*SH/TH+3D0+2D0*TH/SH+
0382      &    TH2/SH2)*FACA
0383           FACGG2=COMFAC*AS**2*9D0/4D0*(UH2/SH2+2D0*UH/SH+3D0+2D0*SH/UH+
0384      &    SH2/UH2)*FACA
0385           FACGG3=COMFAC*AS**2*9D0/4D0*(TH2/UH2+2D0*TH/UH+3D0+2D0*UH/TH+
0386      &    UH2/TH2)
0387           NCHN=NCHN+1
0388           ISIG(NCHN,1)=21
0389           ISIG(NCHN,2)=21
0390           ISIG(NCHN,3)=1
0391           SIGH(NCHN)=0.5D0*FACGG1
0392           NCHN=NCHN+1
0393           ISIG(NCHN,1)=21
0394           ISIG(NCHN,2)=21
0395           ISIG(NCHN,3)=2
0396           SIGH(NCHN)=0.5D0*FACGG2
0397           NCHN=NCHN+1
0398           ISIG(NCHN,1)=21
0399           ISIG(NCHN,2)=21
0400           ISIG(NCHN,3)=3
0401           SIGH(NCHN)=0.5D0*FACGG3
0402   300     CONTINUE
0403
0404         ELSEIF(ISUB.EQ.80) THEN
0405 C...q + gamma -> q' + pi+/-
0406           FQPI=COMFAC*(2D0*AEM/9D0)*(-SH/TH)*(1D0/SH2+1D0/TH2)
0407           ASSH=PYALPS(MAX(0.5D0,0.5D0*SH))
0408           Q2FPSH=0.55D0/LOG(MAX(2D0,2D0*SH))
0409           DELSH=UH*SQRT(ASSH*Q2FPSH)
0410           ASUH=PYALPS(MAX(0.5D0,-0.5D0*UH))
0411           Q2FPUH=0.55D0/LOG(MAX(2D0,-2D0*UH))
0412           DELUH=SH*SQRT(ASUH*Q2FPUH)
0413           DO 320 I=MAX(-2,MMINA),MIN(2,MMAXA)
0414             IF(I.EQ.0) GOTO 320
0415             EI=KCHG(IABS(I),1)/3D0
0416             EJ=SIGN(1D0-ABS(EI),EI)
0417             DO 310 ISDE=1,2
0418               IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 310
0419               IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 310
0420               NCHN=NCHN+1
0421               ISIG(NCHN,ISDE)=I
0422               ISIG(NCHN,3-ISDE)=22
0423               ISIG(NCHN,3)=1
0424               SIGH(NCHN)=FQPI*(EI*DELSH+EJ*DELUH)**2
0425   310       CONTINUE
0426   320     CONTINUE
0427         ENDIF
0428
0429       ELSEIF(ISUB.LE.100) THEN
0430         IF(ISUB.EQ.91) THEN
0431 C...Elastic scattering
0432           SIGS=VINT(315)*VINT(316)*SIGT(0,0,1)
0433
0434         ELSEIF(ISUB.EQ.92) THEN
0435 C...Single diffractive scattering (first side, i.e. XB)
0436           SIGS=VINT(315)*VINT(316)*SIGT(0,0,2)
0437
0438         ELSEIF(ISUB.EQ.93) THEN
0439 C...Single diffractive scattering (second side, i.e. AX)
0440           SIGS=VINT(315)*VINT(316)*SIGT(0,0,3)
0441
0442         ELSEIF(ISUB.EQ.94) THEN
0443 C...Double diffractive scattering
0444           SIGS=VINT(315)*VINT(316)*SIGT(0,0,4)
0445
0446         ELSEIF(ISUB.EQ.95) THEN
0447 C...Low-pT scattering
0448           SIGS=VINT(315)*VINT(316)*SIGT(0,0,5)
0449
0450         ELSEIF(ISUB.EQ.96) THEN
0451 C...Multiple interactions: sum of QCD processes
0452           CALL PYWIDT(21,SH,WDTP,WDTE)
0453
0454 C...q + q' -> q + q'
0455           FACQQ1=COMFAC*AS**2*4D0/9D0*(SH2+UH2)/TH2
0456           FACQQB=COMFAC*AS**2*4D0/9D0*((SH2+UH2)/TH2*FACA-
0457      &    MSTP(34)*2D0/3D0*UH2/(SH*TH))
0458           FACQQ2=COMFAC*AS**2*4D0/9D0*(SH2+TH2)/UH2
0459           FACQQI=-COMFAC*AS**2*4D0/9D0*MSTP(34)*2D0/3D0*SH2/(TH*UH)
0460           RATQQI=(FACQQ1+FACQQ2+FACQQI)/(FACQQ1+FACQQ2)
0461           DO 340 I=-5,5
0462             IF(I.EQ.0) GOTO 340
0463             DO 330 J=-5,5
0464               IF(J.EQ.0) GOTO 330
0465               NCHN=NCHN+1
0466               ISIG(NCHN,1)=I
0467               ISIG(NCHN,2)=J
0468               ISIG(NCHN,3)=111
0469               SIGH(NCHN)=FACQQ1
0470               IF(I.EQ.-J) SIGH(NCHN)=FACQQB
0471               IF(I.EQ.J) THEN
0472                 SIGH(NCHN)=0.5D0*FACQQ1*RATQQI
0473                 NCHN=NCHN+1
0474                 ISIG(NCHN,1)=I
0475                 ISIG(NCHN,2)=J
0476                 ISIG(NCHN,3)=112
0477                 SIGH(NCHN)=0.5D0*FACQQ2*RATQQI
0478               ENDIF
0479   330       CONTINUE
0480   340     CONTINUE
0481
0482 C...q + qbar -> q' + qbar' or g + g
0483           FACQQB=COMFAC*AS**2*4D0/9D0*(TH2+UH2)/SH2*
0484      &    (WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))
0485           FACGG1=COMFAC*AS**2*32D0/27D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)*
0486      &    UH2/SH2)
0487           FACGG2=COMFAC*AS**2*32D0/27D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)*
0488      &    TH2/SH2)
0489           DO 350 I=-5,5
0490             IF(I.EQ.0) GOTO 350
0491             NCHN=NCHN+1
0492             ISIG(NCHN,1)=I
0493             ISIG(NCHN,2)=-I
0494             ISIG(NCHN,3)=121
0495             SIGH(NCHN)=FACQQB
0496             NCHN=NCHN+1
0497             ISIG(NCHN,1)=I
0498             ISIG(NCHN,2)=-I
0499             ISIG(NCHN,3)=131
0500             SIGH(NCHN)=0.5D0*FACGG1
0501             NCHN=NCHN+1
0502             ISIG(NCHN,1)=I
0503             ISIG(NCHN,2)=-I
0504             ISIG(NCHN,3)=132
0505             SIGH(NCHN)=0.5D0*FACGG2
0506   350     CONTINUE
0507
0508 C...q + g -> q + g
0509           FACQG1=COMFAC*AS**2*4D0/9D0*((2D0+MSTP(34)*1D0/4D0)*UH2/TH2-
0510      &    UH/SH)*FACA
0511           FACQG2=COMFAC*AS**2*4D0/9D0*((2D0+MSTP(34)*1D0/4D0)*SH2/TH2-
0512      &    SH/UH)
0513           DO 370 I=-5,5
0514             IF(I.EQ.0) GOTO 370
0515             DO 360 ISDE=1,2
0516               NCHN=NCHN+1
0517               ISIG(NCHN,ISDE)=I
0518               ISIG(NCHN,3-ISDE)=21
0519               ISIG(NCHN,3)=281
0520               SIGH(NCHN)=FACQG1
0521               NCHN=NCHN+1
0522               ISIG(NCHN,ISDE)=I
0523               ISIG(NCHN,3-ISDE)=21
0524               ISIG(NCHN,3)=282
0525               SIGH(NCHN)=FACQG2
0526   360       CONTINUE
0527   370     CONTINUE
0528
0529 C...g + g -> q + qbar (only d, u, s)
0530           IDC0=MDCY(21,2)-1
0531           FLAVWT=0D0
0532           IF(MDME(IDC0+1,1).GE.1) FLAVWT=FLAVWT+
0533      &    SQRT(MAX(0D0,1D0-4D0*PMAS(1,1)**2/SH))
0534           IF(MDME(IDC0+2,1).GE.1) FLAVWT=FLAVWT+
0535      &    SQRT(MAX(0D0,1D0-4D0*PMAS(2,1)**2/SH))
0536           IF(MDME(IDC0+3,1).GE.1) FLAVWT=FLAVWT+
0537      &    SQRT(MAX(0D0,1D0-4D0*PMAS(3,1)**2/SH))
0538           FACQQ1=COMFAC*AS**2*1D0/6D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)*
0539      &    UH2/SH2)*FLAVWT*FACA
0540           FACQQ2=COMFAC*AS**2*1D0/6D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)*
0541      &    TH2/SH2)*FLAVWT*FACA
0542           NCHN=NCHN+1
0543           ISIG(NCHN,1)=21
0544           ISIG(NCHN,2)=21
0545           ISIG(NCHN,3)=531
0546           SIGH(NCHN)=FACQQ1
0547           NCHN=NCHN+1
0548           ISIG(NCHN,1)=21
0549           ISIG(NCHN,2)=21
0550           ISIG(NCHN,3)=532
0551           SIGH(NCHN)=FACQQ2
0552
0553 C...g + g -> c + cbar, b + bbar: modified that/uhat for fixed
0554 C...cos(theta-hat)
0555           DO 380 IFL=4,5
0556           SQMAVG=PMAS(IFL,1)**2
0557           IF(MDME(IDC0+IFL,1).GE.1.AND.SH.GT.4.04D0*SQMAVG) THEN
0558             BE34=SQRT(1D0-4D0*SQMAVG/SH)
0559             THQ=-0.5D0*SH*(1D0-BE34*CTH)
0560             UHQ=-0.5D0*SH*(1D0+BE34*CTH)
0561             THUHQ=THQ*UHQ-SQMAVG*SH
0562             IF(MSTP(34).EQ.0) THEN
0563               FACQQ1=UHQ/THQ-2D0*UHQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/THQ**2
0564               FACQQ2=THQ/UHQ-2D0*THQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/UHQ**2
0565             ELSE
0566               FACQQ1=UHQ/THQ-2.25D0*UHQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/
0567      &        THQ**2+0.5D0*SQMAVG*(THQ+SQMAVG)/THQ**2-SQMAVG**2/(SH*THQ)
0568               FACQQ2=THQ/UHQ-2.25D0*THQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/
0569      &        UHQ**2+0.5D0*SQMAVG*(UHQ+SQMAVG)/UHQ**2-SQMAVG**2/(SH*UHQ)
0570             ENDIF
0571             FACQQ1=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ1*BE34
0572             FACQQ2=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ2*BE34
0573             NCHN=NCHN+1
0574             ISIG(NCHN,1)=21
0575             ISIG(NCHN,2)=21
0576             ISIG(NCHN,3)=531+2*(IFL-3)
0577             SIGH(NCHN)=FACQQ1
0578             NCHN=NCHN+1
0579             ISIG(NCHN,1)=21
0580             ISIG(NCHN,2)=21
0581             ISIG(NCHN,3)=532+2*(IFL-3)
0582             SIGH(NCHN)=FACQQ2
0583           ENDIF
0584   380     CONTINUE
0585
0586 C...g + g -> g + g
0587           FACGG1=COMFAC*AS**2*9D0/4D0*(SH2/TH2+2D0*SH/TH+3D0+
0588      &    2D0*TH/SH+TH2/SH2)*FACA
0589           FACGG2=COMFAC*AS**2*9D0/4D0*(UH2/SH2+2D0*UH/SH+3D0+
0590      &    2D0*SH/UH+SH2/UH2)*FACA
0591           FACGG3=COMFAC*AS**2*9D0/4D0*(TH2/UH2+2D0*TH/UH+3+
0592      &    2D0*UH/TH+UH2/TH2)
0593           NCHN=NCHN+1
0594           ISIG(NCHN,1)=21
0595           ISIG(NCHN,2)=21
0596           ISIG(NCHN,3)=681
0597           SIGH(NCHN)=0.5D0*FACGG1
0598           NCHN=NCHN+1
0599           ISIG(NCHN,1)=21
0600           ISIG(NCHN,2)=21
0601           ISIG(NCHN,3)=682
0602           SIGH(NCHN)=0.5D0*FACGG2
0603           NCHN=NCHN+1
0604           ISIG(NCHN,1)=21
0605           ISIG(NCHN,2)=21
0606           ISIG(NCHN,3)=683
0607           SIGH(NCHN)=0.5D0*FACGG3
0608
0609         ELSEIF(ISUB.EQ.99) THEN
0610 C...f + gamma* -> f.
0611           IF(MINT(107).EQ.4) THEN
0612             Q2GA=VINT(307)
0613             P2GA=VINT(308)
0614             ISDE=2
0615           ELSE
0616             Q2GA=VINT(308)
0617             P2GA=VINT(307)
0618             ISDE=1
0619           ENDIF
0620           COMFAC=PARU(5)*4D0*PARU(1)**2*PARU(101)*VINT(315)*VINT(316)
0621           PM2RHO=PMAS(PYCOMP(113),1)**2
0622           IF(MSTP(19).EQ.0) THEN
0623             COMFAC=COMFAC/Q2GA
0624 C... To use MSTP(19).EQ.1 (less Q2 suppression) with the right factor (1-x)^-1
0625           ELSEIF(MSTP(19).EQ.1) THEN
0626             COMFAC=COMFAC/(Q2GA+PM2RHO)
0627             W2GA=VINT(2)
0628            IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) THEN
0629               XGA=Q2GA/(W2GA+VINT(307)+VINT(308))
0630             ELSE
0631               XGA=Q2GA/(W2GA+Q2GA-PMAS(PYCOMP(MINT(10+ISDE)),1)**2)
0632             ENDIF
0633             COMFAC=COMFAC/MAX(1D-2,1D0-XGA)
0634
0635           ELSEIF(MSTP(19).EQ.2) THEN
0636             COMFAC=COMFAC*Q2GA/(Q2GA+PM2RHO)**2
0637           ELSE
0638             COMFAC=COMFAC*Q2GA/(Q2GA+PM2RHO)**2
0639             W2GA=VINT(2)
0640             IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) THEN
0641               RDRDS=4.1D-3*W2GA**2.167D0/((Q2GA+0.15D0*W2GA)**2*
0642      &        Q2GA**0.75D0)*(1D0+0.11D0*Q2GA*P2GA/(1D0+0.02D0*P2GA**2))
0643               XGA=Q2GA/(W2GA+VINT(307)+VINT(308))
0644             ELSE
0645               RDRDS=1.5D-4*W2GA**2.167D0/((Q2GA+0.041D0*W2GA)**2*
0646      &        Q2GA**0.57D0)
0647               XGA=Q2GA/(W2GA+Q2GA-PMAS(PYCOMP(MINT(10+ISDE)),1)**2)
0648             ENDIF
0649             COMFAC=COMFAC*EXP(-MAX(1D-10,RDRDS))
0650             IF(MSTP(19).EQ.4) COMFAC=COMFAC/MAX(1D-2,1D0-XGA)
0651           ENDIF
0652           DO 390 I=MMINA,MMAXA
0653             IF(I.EQ.0.OR.KFAC(ISDE,I).EQ.0) GOTO 390
0654             IF(IABS(I).LT.10.AND.IABS(I).GT.MSTP(58)) GOTO 390
0655             EI=KCHG(IABS(I),1)/3D0
0656             NCHN=NCHN+1
0657             ISIG(NCHN,ISDE)=I
0658             ISIG(NCHN,3-ISDE)=22
0659             ISIG(NCHN,3)=1
0660             SIGH(NCHN)=COMFAC*EI**2
0661   390     CONTINUE
0662         ENDIF
0663
0664       ELSE
0665         IF(ISUB.EQ.114.OR.ISUB.EQ.115) THEN
0666 C...g + g -> gamma + gamma or g + g -> g + gamma
0667           A0STUR=0D0
0668           A0STUI=0D0
0669           A0TSUR=0D0
0670           A0TSUI=0D0
0671           A0UTSR=0D0
0672           A0UTSI=0D0
0673           A1STUR=0D0
0674           A1STUI=0D0
0675           A2STUR=0D0
0676           A2STUI=0D0
0677           ALST=LOG(-SH/TH)
0678           ALSU=LOG(-SH/UH)
0679           ALTU=LOG(TH/UH)
0680           IMAX=2*MSTP(1)
0681           IF(MSTP(38).GE.1.AND.MSTP(38).LE.8) IMAX=MSTP(38)
0682           DO 400 I=1,IMAX
0683             EI=KCHG(IABS(I),1)/3D0
0684             EIWT=EI**2
0685             IF(ISUB.EQ.115) EIWT=EI
0686             SQMQ=PMAS(I,1)**2
0687             EPSS=4D0*SQMQ/SH
0688             EPST=4D0*SQMQ/TH
0689             EPSU=4D0*SQMQ/UH
0690             IF((MSTP(38).GE.1.AND.MSTP(38).LE.8).OR.EPSS.LT.1D-4) THEN
0691               B0STUR=1D0+(TH-UH)/SH*ALTU+0.5D0*(TH2+UH2)/SH2*(ALTU**2+
0692      &        PARU(1)**2)
0693               B0STUI=0D0
0694               B0TSUR=1D0+(SH-UH)/TH*ALSU+0.5D0*(SH2+UH2)/TH2*ALSU**2
0695               B0TSUI=-PARU(1)*((SH-UH)/TH+(SH2+UH2)/TH2*ALSU)
0696               B0UTSR=1D0+(SH-TH)/UH*ALST+0.5D0*(SH2+TH2)/UH2*ALST**2
0697               B0UTSI=-PARU(1)*((SH-TH)/UH+(SH2+TH2)/UH2*ALST)
0698               B1STUR=-1D0
0699               B1STUI=0D0
0700               B2STUR=-1D0
0701               B2STUI=0D0
0702             ELSE
0703               CALL PYWAUX(1,EPSS,W1SR,W1SI)
0704               CALL PYWAUX(1,EPST,W1TR,W1TI)
0705               CALL PYWAUX(1,EPSU,W1UR,W1UI)
0706               CALL PYWAUX(2,EPSS,W2SR,W2SI)
0707               CALL PYWAUX(2,EPST,W2TR,W2TI)
0708               CALL PYWAUX(2,EPSU,W2UR,W2UI)
0709               CALL PYI3AU(EPSS,TH/UH,Y3STUR,Y3STUI)
0710               CALL PYI3AU(EPSS,UH/TH,Y3SUTR,Y3SUTI)
0711               CALL PYI3AU(EPST,SH/UH,Y3TSUR,Y3TSUI)
0712               CALL PYI3AU(EPST,UH/SH,Y3TUSR,Y3TUSI)
0713               CALL PYI3AU(EPSU,SH/TH,Y3USTR,Y3USTI)
0714               CALL PYI3AU(EPSU,TH/SH,Y3UTSR,Y3UTSI)
0715               B0STUR=1D0+(1D0+2D0*TH/SH)*W1TR+(1D0+2D0*UH/SH)*W1UR+
0716      &        0.5D0*((TH2+UH2)/SH2-EPSS)*(W2TR+W2UR)-
0717      &        0.25D0*EPST*(1D0-0.5D0*EPSS)*(Y3SUTR+Y3TUSR)-
0718      &        0.25D0*EPSU*(1D0-0.5D0*EPSS)*(Y3STUR+Y3UTSR)+
0719      &        0.25D0*(-2D0*(TH2+UH2)/SH2+4D0*EPSS+EPST+EPSU+
0720      &        0.5D0*EPST*EPSU)*(Y3TSUR+Y3USTR)
0721               B0STUI=(1D0+2D0*TH/SH)*W1TI+(1D0+2D0*UH/SH)*W1UI+
0722      &        0.5D0*((TH2+UH2)/SH2-EPSS)*(W2TI+W2UI)-
0723      &        0.25D0*EPST*(1D0-0.5D0*EPSS)*(Y3SUTI+Y3TUSI)-
0724      &        0.25D0*EPSU*(1D0-0.5D0*EPSS)*(Y3STUI+Y3UTSI)+
0725      &        0.25D0*(-2D0*(TH2+UH2)/SH2+4D0*EPSS+EPST+EPSU+
0726      &        0.5D0*EPST*EPSU)*(Y3TSUI+Y3USTI)
0727               B0TSUR=1D0+(1D0+2D0*SH/TH)*W1SR+(1D0+2D0*UH/TH)*W1UR+
0728      &        0.5D0*((SH2+UH2)/TH2-EPST)*(W2SR+W2UR)-
0729      &        0.25D0*EPSS*(1D0-0.5D0*EPST)*(Y3TUSR+Y3SUTR)-
0730      &        0.25D0*EPSU*(1D0-0.5D0*EPST)*(Y3TSUR+Y3USTR)+
0731      &        0.25D0*(-2D0*(SH2+UH2)/TH2+4D0*EPST+EPSS+EPSU+
0732      &        0.5D0*EPSS*EPSU)*(Y3STUR+Y3UTSR)
0733               B0TSUI=(1D0+2D0*SH/TH)*W1SI+(1D0+2D0*UH/TH)*W1UI+
0734      &        0.5D0*((SH2+UH2)/TH2-EPST)*(W2SI+W2UI)-
0735      &        0.25D0*EPSS*(1D0-0.5D0*EPST)*(Y3TUSI+Y3SUTI)-
0736      &        0.25D0*EPSU*(1D0-0.5D0*EPST)*(Y3TSUI+Y3USTI)+
0737      &        0.25D0*(-2D0*(SH2+UH2)/TH2+4D0*EPST+EPSS+EPSU+
0738      &        0.5D0*EPSS*EPSU)*(Y3STUI+Y3UTSI)
0739               B0UTSR=1D0+(1D0+2D0*TH/UH)*W1TR+(1D0+2D0*SH/UH)*W1SR+
0740      &        0.5D0*((TH2+SH2)/UH2-EPSU)*(W2TR+W2SR)-
0741      &        0.25D0*EPST*(1D0-0.5D0*EPSU)*(Y3USTR+Y3TSUR)-
0742      &        0.25D0*EPSS*(1D0-0.5D0*EPSU)*(Y3UTSR+Y3STUR)+
0743      &        0.25D0*(-2D0*(TH2+SH2)/UH2+4D0*EPSU+EPST+EPSS+
0744      &        0.5D0*EPST*EPSS)*(Y3TUSR+Y3SUTR)
0745               B0UTSI=(1D0+2D0*TH/UH)*W1TI+(1D0+2D0*SH/UH)*W1SI+
0746      &        0.5D0*((TH2+SH2)/UH2-EPSU)*(W2TI+W2SI)-
0747      &        0.25D0*EPST*(1D0-0.5D0*EPSU)*(Y3USTI+Y3TSUI)-
0748      &        0.25D0*EPSS*(1D0-0.5D0*EPSU)*(Y3UTSI+Y3STUI)+
0749      &        0.25D0*(-2D0*(TH2+SH2)/UH2+4D0*EPSU+EPST+EPSS+
0750      &        0.5D0*EPST*EPSS)*(Y3TUSI+Y3SUTI)
0751               B1STUR=-1D0-0.25D0*(EPSS+EPST+EPSU)*(W2SR+W2TR+W2UR)+
0752      &        0.25D0*(EPSU+0.5D0*EPSS*EPST)*(Y3SUTR+Y3TUSR)+
0753      &        0.25D0*(EPST+0.5D0*EPSS*EPSU)*(Y3STUR+Y3UTSR)+
0754      &        0.25D0*(EPSS+0.5D0*EPST*EPSU)*(Y3TSUR+Y3USTR)
0755               B1STUI=-0.25D0*(EPSS+EPST+EPSU)*(W2SI+W2TI+W2UI)+
0756      &        0.25D0*(EPSU+0.5D0*EPSS*EPST)*(Y3SUTI+Y3TUSI)+
0757      &        0.25D0*(EPST+0.5D0*EPSS*EPSU)*(Y3STUI+Y3UTSI)+
0758      &        0.25D0*(EPSS+0.5D0*EPST*EPSU)*(Y3TSUI+Y3USTI)
0759               B2STUR=-1D0+0.125D0*EPSS*EPST*(Y3SUTR+Y3TUSR)+
0760      &        0.125D0*EPSS*EPSU*(Y3STUR+Y3UTSR)+
0761      &        0.125D0*EPST*EPSU*(Y3TSUR+Y3USTR)
0762               B2STUI=0.125D0*EPSS*EPST*(Y3SUTI+Y3TUSI)+
0763      &        0.125D0*EPSS*EPSU*(Y3STUI+Y3UTSI)+
0764      &        0.125D0*EPST*EPSU*(Y3TSUI+Y3USTI)
0765             ENDIF
0766             A0STUR=A0STUR+EIWT*B0STUR
0767             A0STUI=A0STUI+EIWT*B0STUI
0768             A0TSUR=A0TSUR+EIWT*B0TSUR
0769             A0TSUI=A0TSUI+EIWT*B0TSUI
0770             A0UTSR=A0UTSR+EIWT*B0UTSR
0771             A0UTSI=A0UTSI+EIWT*B0UTSI
0772             A1STUR=A1STUR+EIWT*B1STUR
0773             A1STUI=A1STUI+EIWT*B1STUI
0774             A2STUR=A2STUR+EIWT*B2STUR
0775             A2STUI=A2STUI+EIWT*B2STUI
0776   400     CONTINUE
0777           ASQSUM=A0STUR**2+A0STUI**2+A0TSUR**2+A0TSUI**2+A0UTSR**2+
0778      &    A0UTSI**2+4D0*A1STUR**2+4D0*A1STUI**2+A2STUR**2+A2STUI**2
0779           FACGG=COMFAC*FACA/(16D0*PARU(1)**2)*AS**2*AEM**2*ASQSUM
0780           FACGP=COMFAC*FACA*5D0/(192D0*PARU(1)**2)*AS**3*AEM*ASQSUM
0781           IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 410
0782           NCHN=NCHN+1
0783           ISIG(NCHN,1)=21
0784           ISIG(NCHN,2)=21
0785           ISIG(NCHN,3)=1
0786           IF(ISUB.EQ.114) SIGH(NCHN)=0.5D0*FACGG
0787           IF(ISUB.EQ.115) SIGH(NCHN)=FACGP
0788   410     CONTINUE
0789
0790         ELSEIF(ISUB.EQ.131.OR.ISUB.EQ.132) THEN
0791 C...f + gamma*_(T,L) -> f + g (q + gamma*_(T,L) -> q + g only)
0792           PH=0D0
0793           IF(MINT(15).EQ.22.AND.MINT(107).EQ.0.AND.VINT(3).LT.0D0)
0794      &    PH=VINT(3)**2
0795           IF(MINT(16).EQ.22.AND.MINT(108).EQ.0.AND.VINT(4).LT.0D0)
0796      &    PH=VINT(4)**2
0797           IF(ISUB.EQ.131) THEN
0798             FGQ=COMFAC*AS*AEM*8D0/3D0*SH**2/(SH+PH)**2*
0799      &      ((SH2+UH2-2D0*PH*TH)/(-SH*UH)-2D0*PH*TH/(SH+PH)**2)
0800           ELSE
0801             FGQ=COMFAC*AS*AEM*8D0/3D0*SH**2/(SH+PH)**4*(-4D0*PH*TH)
0802           ENDIF
0803           DO 430 I=MMINA,MMAXA
0804             IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 430
0805             EI=KCHG(IABS(I),1)/3D0
0806             FACGQ=FGQ*EI**2
0807             DO 420 ISDE=1,2
0808               IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 420
0809               IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 420
0810               NCHN=NCHN+1
0811               ISIG(NCHN,ISDE)=I
0812               ISIG(NCHN,3-ISDE)=22
0813               ISIG(NCHN,3)=1
0814               SIGH(NCHN)=FACGQ
0815   420       CONTINUE
0816   430     CONTINUE
0817
0818         ELSEIF(ISUB.EQ.133.OR.ISUB.EQ.134) THEN
0819 C...f + gamma*_(T,L) -> f + gamma
0820           PH=0D0
0821           IF(MINT(15).EQ.22.AND.MINT(107).EQ.0.AND.VINT(3).LT.0D0)
0822      &    PH=VINT(3)**2
0823           IF(MINT(16).EQ.22.AND.MINT(108).EQ.0.AND.VINT(4).LT.0D0)
0824      &    PH=VINT(4)**2
0825           IF(ISUB.EQ.133) THEN
0826             FGQ=COMFAC*AEM**2*2D0*SH**2/(SH+PH)**2*
0827      &      ((SH2+UH2-2D0*PH*TH)/(-SH*UH)-2D0*PH*TH/(SH+PH)**2)
0828           ELSE
0829             FGQ=COMFAC*AEM**2*2D0*SH**2/(SH+PH)**4*(-4D0*PH*TH)
0830           ENDIF
0831           DO 450 I=MMINA,MMAXA
0832             IF(I.EQ.0) GOTO 450
0833             EI=KCHG(IABS(I),1)/3D0
0834             FACGQ=FGQ*EI**4
0835             DO 440 ISDE=1,2
0836               IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 440
0837               IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 440
0838               NCHN=NCHN+1
0839               ISIG(NCHN,ISDE)=I
0840               ISIG(NCHN,3-ISDE)=22
0841               ISIG(NCHN,3)=1
0842               SIGH(NCHN)=FACGQ
0843   440       CONTINUE
0844   450     CONTINUE
0845
0846         ELSEIF(ISUB.EQ.135.OR.ISUB.EQ.136) THEN
0847 C...g + gamma*_(T,L) -> f + fbar (g + gamma*_(T,L) -> q + qbar only)
0848           PH=0D0
0849           IF(MINT(15).EQ.22.AND.MINT(107).EQ.0.AND.VINT(3).LT.0D0)
0850      &    PH=VINT(3)**2
0851           IF(MINT(16).EQ.22.AND.MINT(108).EQ.0.AND.VINT(4).LT.0D0)
0852      &    PH=VINT(4)**2
0853           CALL PYWIDT(21,SH,WDTP,WDTE)
0854           WDTESU=0D0
0855           DO 460 I=1,MIN(8,MDCY(21,3))
0856             EF=KCHG(I,1)/3D0
0857             WDTESU=WDTESU+EF**2*(WDTE(I,1)+WDTE(I,2)+WDTE(I,3)+
0858      &      WDTE(I,4))
0859   460     CONTINUE
0860           IF(ISUB.EQ.135) THEN
0861             FACQQ=COMFAC*AEM*AS*WDTESU*SH**2/(SH+PH)**2*
0862      &      ((TH2+UH2-2D0*PH*SH)/(TH*UH)+4D0*PH*SH/(SH+PH)**2)
0863           ELSE
0864             FACQQ=COMFAC*AEM*AS*WDTESU*SH**2/(SH+PH)**4*8D0*PH*SH
0865           ENDIF
0866           IF(KFAC(1,21)*KFAC(2,22).NE.0) THEN
0867             NCHN=NCHN+1
0868             ISIG(NCHN,1)=21
0869             ISIG(NCHN,2)=22
0870             ISIG(NCHN,3)=1
0871             SIGH(NCHN)=FACQQ
0872           ENDIF
0873           IF(KFAC(1,22)*KFAC(2,21).NE.0) THEN
0874             NCHN=NCHN+1
0875             ISIG(NCHN,1)=22
0876             ISIG(NCHN,2)=21
0877             ISIG(NCHN,3)=1
0878             SIGH(NCHN)=FACQQ
0879           ENDIF
0880
0881         ELSEIF(ISUB.GE.137.AND.ISUB.LE.140) THEN
0882 C...gamma*_(T,L) + gamma*_(T,L) -> f + fbar
0883           PH1=0D0
0884           IF(VINT(3).LT.0D0) PH1=VINT(3)**2
0885           PH2=0D0
0886           IF(VINT(4).LT.0D0) PH2=VINT(4)**2
0887           CALL PYWIDT(22,SH,WDTP,WDTE)
0888           WDTESU=0D0
0889           DO 470 I=1,MIN(12,MDCY(22,3))
0890             IF(I.LE.8) EF= KCHG(I,1)/3D0
0891             IF(I.GE.9) EF= KCHG(9+2*(I-8),1)/3D0
0892             WDTESU=WDTESU+EF**2*(WDTE(I,1)+WDTE(I,2)+WDTE(I,3)+
0893      &      WDTE(I,4))
0894   470     CONTINUE
0895           DLAMB2=(TH+UH)**2-4D0*PH1*PH2
0896           IF(ISUB.EQ.137) THEN
0897             FPARAM=-SH*(TH+UH)/DLAMB2
0898             FACFF=COMFAC*AEM**2*WDTESU*2D0*SH2/(DLAMB2*TH2*UH2)*
0899      &      (TH*UH-PH1*PH2)*((TH2+UH2)*(1D0-2D0*FPARAM*(1D0-FPARAM))-
0900      &      2D0*PH1*PH2*FPARAM**2)
0901           ELSEIF(ISUB.EQ.138) THEN
0902             FACFF=COMFAC*AEM**2*WDTESU*4D0*SH2*SH/(DLAMB2**2*TH2*UH2)*
0903      &      PH2*(4D0*(TH*UH-PH1*PH2)*(TH*UH+PH1*SH*(TH-UH)**2/DLAMB2)+
0904      &      2D0*PH1**2*(TH-UH)**2)
0905           ELSEIF(ISUB.EQ.139) THEN
0906             FACFF=COMFAC*AEM**2*WDTESU*4D0*SH2*SH/(DLAMB2**2*TH2*UH2)*
0907      &      PH1*(4D0*(TH*UH-PH1*PH2)*(TH*UH+PH2*SH*(TH-UH)**2/DLAMB2)+
0908      &      2D0*PH2**2*(TH-UH)**2)
0909           ELSE
0910             FACFF=COMFAC*AEM**2*WDTESU*32D0*SH2**2/(DLAMB2**3*TH2*UH2)*
0911      &      PH1*PH2*(TH*UH-PH1*PH2)*(TH-UH)**2
0912           ENDIF
0913           IF(KFAC(1,22)*KFAC(2,22).NE.0) THEN
0914             NCHN=NCHN+1
0915             ISIG(NCHN,1)=22
0916             ISIG(NCHN,2)=22
0917             ISIG(NCHN,3)=1
0918             SIGH(NCHN)=FACFF
0919           ENDIF
0920
0921         ENDIF
0922       ENDIF
0923
0924       RETURN
0925       END