pythiaeRHIC/pythia/pysgtc.f

0001
0002 C*********************************************************************
0003
0004 C...PYSGTC
0005 C...Subprocess cross sections for Technicolor processes.
0006 C...Auxiliary to PYSIGH.
0007
0008       SUBROUTINE PYSGTC(NCHN,SIGS)
0009
0010 C...Double precision and integer declarations
0011       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0012       IMPLICIT INTEGER(I-N)
0013       INTEGER PYK,PYCHGE,PYCOMP
0014 C...Parameter statement to help give large particle numbers.
0015       PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000,
0016      &KEXCIT=4000000,KDIMEN=5000000)
0017 C...Commonblocks
0018       COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0019       COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
0020       COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5)
0021       COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
0022       COMMON/PYINT1/MINT(400),VINT(400)
0023       COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2)
0024       COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000)
0025       COMMON/PYINT4/MWID(500),WIDS(500,5)
0026       COMMON/PYTCSM/ITCM(0:99),RTCM(0:99)
0027       COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA,
0028      &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4,
0029      &SHR,SQPTH,TAUP,BE34,CTH,X(2),SQMZ,SQMW,GMMZ,GMMW,
0030      &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR
0031       SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYPARS/,/PYINT1/,/PYINT2/,
0032      &/PYINT3/,/PYINT4/,/PYTCSM/,/PYSGCM/
0033 C...Local arrays and complex variables
0034       DIMENSION WDTP(0:400),WDTE(0:400,0:5)
0035       COMPLEX*16 SSMZ,SSMR,SSMO,DETD,F2L,F2R,DARHO,DZRHO,DAOME,DZOME
0036       COMPLEX*16 DAA,DZZ,DAZ,DWW,DWRHO
0037       COMPLEX*16 ZTC(6,6),YTC(6,6),DGGS,DGGT,DGGU,DGVS,DGVT,DGVU
0038       COMPLEX*16 DQQS,DQQT,DQQU,DQTS,DQGS,DTGS
0039       COMPLEX*16 DVVS,DVVT,DVVU
0040       INTEGER INDX(6)
0041
0042 C...Combinations of weak mixing angle.
0043       TANW=SQRT(XW/XW1)
0044       CT2W=(1D0-2D0*XW)/(2D0*XW/TANW)
0045
0046 C...Convert almost equivalent technicolor processes into
0047 C...a few basic processes, and set distinguishing parameters.
0048       IF(ISUB.GE.361.AND.ISUB.LE.379) THEN
0049         SQTV=RTCM(12)**2
0050         SQTA=RTCM(13)**2
0051         SN2W=2D0*SQRT(PARU(102)*(1D0-PARU(102)))
0052         CS2W=1D0-2D0*PARU(102)
0053         TANW=SQRT(PARU(102)/(1D0-PARU(102)))
0054         CT2W=CS2W/SN2W
0055         CSXI=COS(ASIN(RTCM(3)))
0056         CSXIP=COS(ASIN(RTCM(4)))
0057         QUPD=2D0*RTCM(2)-1D0
0058         Q2UD=RTCM(2)**2+(RTCM(2)-1D0)**2
0059 C... rho_tc0 -> W_L W_L
0060         IF(ISUB.EQ.361) THEN
0061            KFA=24
0062            KFB=24
0063            CAB2=RTCM(3)**4
0064 C... rho_tc0 -> W_L pi_tc-
0065         ELSEIF(ISUB.EQ.362) THEN
0066            KFA=24
0067            KFB=KTECHN+211
0068            ISUB=361
0069            CAB2=RTCM(3)**2*(1D0-RTCM(3)**2)
0070 C... pi_tc pi_tc
0071         ELSEIF(ISUB.EQ.363) THEN
0072            KFA=KTECHN+211
0073            KFB=KTECHN+211
0074            ISUB=361
0075            CAB2=(1D0-RTCM(3)**2)**2
0076 C... rho_tc0/omega_tc -> gamma pi_tc
0077         ELSEIF(ISUB.EQ.364) THEN
0078            KFA=22
0079            KFB=KTECHN+111
0080            VOGP=CSXI/RTCM(12)
0081 C..........!!!
0082            VRGP=VOGP*QUPD
0083            AOGP=0D0
0084            ARGP=0D0
0085            VAGP=2D0*QUPD*CSXI
0086            VZGP=QUPD*CSXI*(1D0-4D0*PARU(102))/SN2W
0087 C... gamma pi_tc'
0088         ELSEIF(ISUB.EQ.365) THEN
0089            KFA=22
0090            KFB=KTECHN+221
0091            ISUB=364
0092            VRGP=CSXIP/RTCM(12)
0093 C..........!!!!
0094            VOGP=VRGP*QUPD
0095            AOGP=0D0
0096            ARGP=0D0
0097            VAGP=2D0*Q2UD*CSXIP
0098            VZGP=CSXIP/SN2W*(1D0-4D0*PARU(102)*Q2UD)
0099 C... Z pi_tc
0100         ELSEIF(ISUB.EQ.366) THEN
0101            KFA=23
0102            KFB=KTECHN+111
0103            ISUB=364
0104            VOGP=CSXI*CT2W/RTCM(12)
0105            VRGP=-QUPD*CSXI*TANW/RTCM(12)
0106            AOGP=0D0
0107            ARGP=0D0
0108            VAGP=QUPD*CSXI*(1D0-4D0*PARU(102))/SN2W
0109            VZGP=-QUPD*CSXI*CS2W/(1D0-PARU(102))
0110 C... Z pi_tc'
0111         ELSEIF(ISUB.EQ.367) THEN
0112            KFA=23
0113            KFB=KTECHN+221
0114            ISUB=364
0115            VRGP=CSXIP*CT2W/RTCM(12)
0116            VOGP=-QUPD*CSXIP*TANW/RTCM(12)
0117            AOGP=0D0
0118            ARGP=0D0
0119            VAGP=CSXIP*(1D0-4D0*Q2UD*PARU(102))/SN2W
0120            VZGP=2D0*CSXIP*(CS2W+4D0*Q2UD*PARU(102)**2)/SN2W**2
0121 C... W_T pi_tc
0122         ELSEIF(ISUB.EQ.368) THEN
0123            KFA=24
0124            KFB=KTECHN+211
0125            ISUB=364
0126            VOGP=CSXI/(2D0*SQRT(PARU(102)))/RTCM(12)
0127            VRGP=0D0
0128            AOGP=0D0
0129 C..........!!!!
0130            ARGP=-CSXI/(2D0*SQRT(PARU(102)))/RTCM(13)
0131            VAGP=QUPD*CSXI/(2D0*SQRT(PARU(102)))
0132            VZGP=-QUPD*CSXI/(2D0*SQRT(1D0-PARU(102)))
0133 C... rho_tc+ -> W_L Z_L
0134         ELSEIF(ISUB.EQ.370) THEN
0135            KFA=24
0136            KFB=23
0137            CAB2=RTCM(3)**4
0138 C... W_L pi_tc0
0139         ELSEIF(ISUB.EQ.371) THEN
0140            KFA=24
0141            KFB=KTECHN+111
0142            ISUB=370
0143            CAB2=RTCM(3)**2*(1D0-RTCM(3)**2)
0144 C... Z_L pi_tc+
0145         ELSEIF(ISUB.EQ.372) THEN
0146            KFA=KTECHN+211
0147            KFB=23
0148            ISUB=370
0149            CAB2=RTCM(3)**2*(1D0-RTCM(3)**2)
0150 C... pi_tc+ pi_tc0
0151         ELSEIF(ISUB.EQ.373) THEN
0152            KFA=KTECHN+211
0153            KFB=KTECHN+111
0154            ISUB=370
0155            CAB2=(1D0-RTCM(3)**2)**2
0156 C... gamma pi_tc+
0157         ELSEIF(ISUB.EQ.374) THEN
0158            KFA=KTECHN+211
0159            KFB=22
0160            VRGP=QUPD*CSXI
0161            ARGP=0D0
0162            VWGP=QUPD*CSXI/(2D0*SQRT(PARU(102)))
0163 C... Z_T pi_tc+
0164         ELSEIF(ISUB.EQ.375) THEN
0165            KFA=KTECHN+211
0166            KFB=23
0167            ISUB=374
0168            VRGP=-QUPD*CSXI*TANW
0169            ARGP=CSXI/(2D0*SQRT(PARU(102)*(1D0-PARU(102))))
0170            VWGP=-QUPD*CSXI/(2D0*SQRT(1D0-PARU(102)))
0171 C... W_T pi_tc0
0172         ELSEIF(ISUB.EQ.376) THEN
0173            KFA=24
0174            KFB=KTECHN+111
0175            ISUB=374
0176            VRGP=0D0
0177            ARGP=-CSXI/(2D0*SQRT(PARU(102)))
0178            VWGP=0D0
0179 C... W_T pi_tc0'
0180         ELSEIF(ISUB.EQ.377) THEN
0181            KFA=24
0182            KFB=KTECHN+221
0183            ISUB=374
0184            ARGP=0D0
0185            VRGP=CSXIP/(2D0*SQRT(PARU(102)))
0186            VWGP=CSXIP/(2D0*PARU(102))
0187         ENDIF
0188       ENDIF
0189
0190 C...QCD 2 -> 2 processes: corrections from virtual technicolor exchange.
0191       IF(ISUB.GE.381.AND.ISUB.LE.388) THEN
0192         IF(ITCM(5).LE.4) THEN
0193           SQDQQS=1D0/SH2
0194           SQDQQT=1D0/TH2
0195           SQDQQU=1D0/UH2
0196           SQDGGS=SQDQQS
0197           SQDGGT=SQDQQT
0198           SQDGGU=SQDQQU
0199           REDGGS=1D0/SH
0200           REDGGT=1D0/TH
0201           REDGGU=1D0/UH
0202           REDGTU=1D0/UH/TH
0203           REDGSU=1D0/SH/UH
0204           REDGST=1D0/SH/TH
0205           REDQST=1D0/SH/TH
0206           REDQTU=1D0/UH/TH
0207           SQDLGS=0D0
0208           SQDLGT=0D0
0209           SQDQTS=SQDQQS
0210         ELSEIF(ITCM(5).EQ.5) THEN
0211           TANT3=RTCM(21)
0212           IF(ITCM(2).EQ.0) THEN
0213             IMDL=1
0214           ELSE
0215             IMDL=2
0216           ENDIF
0217           ALPRHT=2.91D0*(3D0/ITCM(1))
0218           SIN2T=2D0*TANT3/(TANT3**2+1D0)
0219           SINT3=TANT3/SQRT(TANT3**2+1D0)
0220           XIG=SQRT(PYALPS(SH)/ALPRHT)
0221           X12=(RTCM(29)*SQRT(1D0-RTCM(29)**2)*COS(RTCM(30))+
0222      &    RTCM(31)*SQRT(1D0-RTCM(31)**2)*COS(RTCM(32)))/SQRT(2D0)/SIN2T
0223           X21=(RTCM(29)*SQRT(1D0-RTCM(29)**2)*SIN(RTCM(30))+
0224      &    RTCM(31)*SQRT(1D0-RTCM(31)**2)*SIN(RTCM(32)))/SQRT(2D0)/SIN2T
0225           X11=(.25D0*(RTCM(29)**2+RTCM(31)**2+2D0)-
0226      &    SINT3**2)*2D0/SIN2T
0227           X22=(.25D0*(2D0-RTCM(29)**2-RTCM(31)**2)-
0228      &    SINT3**2)*2D0/SIN2T
0229
0230           SM1122=.5D0*(2D0-RTCM(29)**2-RTCM(31)**2)*RTCM(28)**2
0231           SM1112=X12*RTCM(28)**2*SIN2T
0232           SM1121=-X21*RTCM(28)**2*SIN2T
0233           SM2212=-SM1112
0234           SM2221=-SM1121
0235           SM1221=-.5D0*((1D0-RTCM(29)**2)*SIN(2D0*RTCM(30))+
0236      &    (1D0-RTCM(31)**2)*SIN(2D0*RTCM(32)))*RTCM(28)**2
0237
0238 C.........SH LOOP
0239           ZTC(1,1)=DCMPLX(SH,0D0)
0240           CALL PYWIDT(3100021,SH,WDTP,WDTE)
0241           IF(WDTP(0).GT.RTCM(33)*SHR) WDTP(0)=RTCM(33)*SHR
0242           ZTC(2,2)=DCMPLX(SH-PMAS(PYCOMP(3100021),1)**2,-SHR*WDTP(0))
0243           CALL PYWIDT(3100113,SH,WDTP,WDTE)
0244           ZTC(3,3)=DCMPLX(SH-PMAS(PYCOMP(3100113),1)**2,-SHR*WDTP(0))
0245           CALL PYWIDT(3400113,SH,WDTP,WDTE)
0246           ZTC(4,4)=DCMPLX(SH-PMAS(PYCOMP(3400113),1)**2,-SHR*WDTP(0))
0247           CALL PYWIDT(3200113,SH,WDTP,WDTE)
0248           ZTC(5,5)=DCMPLX(SH-PMAS(PYCOMP(3200113),1)**2,-SHR*WDTP(0))
0249           CALL PYWIDT(3300113,SH,WDTP,WDTE)
0250           ZTC(6,6)=DCMPLX(SH-PMAS(PYCOMP(3300113),1)**2,-SHR*WDTP(0))
0251           ZTC(1,2)=(0D0,0D0)
0252           ZTC(1,3)=DCMPLX(SH*XIG,0D0)
0253           ZTC(1,4)=ZTC(1,3)
0254           ZTC(1,5)=ZTC(1,2)
0255           ZTC(1,6)=ZTC(1,2)
0256           ZTC(2,3)=DCMPLX(SH*XIG*X11,0D0)
0257           ZTC(2,4)=DCMPLX(SH*XIG*X22,0D0)
0258           ZTC(2,5)=DCMPLX(SH*XIG*X12,0D0)
0259           ZTC(2,6)=DCMPLX(SH*XIG*X21,0D0)
0260           ZTC(3,4)=-SM1122
0261           ZTC(3,5)=-SM1112
0262           ZTC(3,6)=-SM1121
0263           ZTC(4,5)=-SM2212
0264           ZTC(4,6)=-SM2221
0265           ZTC(5,6)=-SM1221
0266
0267           DO 110 I=1,5
0268             DO 100 J=I+1,6
0269                ZTC(J,I)=ZTC(I,J)
0270   100       CONTINUE
0271   110     CONTINUE
0272           CALL PYLDCM(ZTC,6,6,INDX,D)
0273           DO 130 I=1,6
0274             DO 120 J=1,6
0275              YTC(I,J)=(0D0,0D0)
0276               IF(I.EQ.J) YTC(I,J)=(1D0,0D0)
0277   120       CONTINUE
0278   130     CONTINUE
0279
0280           DO 140 I=1,6
0281             CALL PYBKSB(ZTC,6,6,INDX,YTC(1,I))
0282   140     CONTINUE
0283           DGGS=YTC(1,1)
0284           DVVS=YTC(2,2)
0285           DGVS=YTC(1,2)
0286
0287           XIG=SQRT(PYALPS(-TH)/ALPRHT)
0288 C.........TH LOOP
0289           ZTC(1,1)=DCMPLX(TH)
0290           ZTC(2,2)=DCMPLX(TH-PMAS(PYCOMP(3100021),1)**2)
0291           ZTC(3,3)=DCMPLX(TH-PMAS(PYCOMP(3100113),1)**2)
0292           ZTC(4,4)=DCMPLX(TH-PMAS(PYCOMP(3400113),1)**2)
0293           ZTC(5,5)=DCMPLX(TH-PMAS(PYCOMP(3200113),1)**2)
0294           ZTC(6,6)=DCMPLX(TH-PMAS(PYCOMP(3300113),1)**2)
0295           ZTC(1,2)=(0D0,0D0)
0296           ZTC(1,3)=DCMPLX(TH*XIG,0D0)
0297           ZTC(1,4)=ZTC(1,3)
0298           ZTC(1,5)=ZTC(1,2)
0299           ZTC(1,6)=ZTC(1,2)
0300           ZTC(2,3)=DCMPLX(TH*XIG*X11,0D0)
0301           ZTC(2,4)=DCMPLX(TH*XIG*X22,0D0)
0302           ZTC(2,5)=DCMPLX(TH*XIG*X12,0D0)
0303           ZTC(2,6)=DCMPLX(TH*XIG*X21,0D0)
0304           ZTC(3,4)=-SM1122
0305           ZTC(3,5)=-SM1112
0306           ZTC(3,6)=-SM1121
0307           ZTC(4,5)=-SM2212
0308           ZTC(4,6)=-SM2221
0309           ZTC(5,6)=-SM1221
0310           DO 160 I=1,5
0311             DO 150 J=I+1,6
0312                ZTC(J,I)=ZTC(I,J)
0313   150       CONTINUE
0314   160     CONTINUE
0315           CALL PYLDCM(ZTC,6,6,INDX,D)
0316           DO 180 I=1,6
0317             DO 170 J=1,6
0318               YTC(I,J)=(0D0,0D0)
0319               IF(I.EQ.J) YTC(I,J)=(1D0,0D0)
0320   170       CONTINUE
0321   180     CONTINUE
0322           DO 190 I=1,6
0323             CALL PYBKSB(ZTC,6,6,INDX,YTC(1,I))
0324   190     CONTINUE
0325           DGGT=YTC(1,1)
0326           DVVT=YTC(2,2)
0327           DGVT=YTC(1,2)
0328
0329           XIG=SQRT(PYALPS(-UH)/ALPRHT)
0330 C.........UH LOOP
0331           ZTC(1,1)=DCMPLX(UH,0D0)
0332           ZTC(2,2)=DCMPLX(UH-PMAS(PYCOMP(3100021),1)**2)
0333           ZTC(3,3)=DCMPLX(UH-PMAS(PYCOMP(3100113),1)**2)
0334           ZTC(4,4)=DCMPLX(UH-PMAS(PYCOMP(3400113),1)**2)
0335           ZTC(5,5)=DCMPLX(UH-PMAS(PYCOMP(3200113),1)**2)
0336           ZTC(6,6)=DCMPLX(UH-PMAS(PYCOMP(3300113),1)**2)
0337           ZTC(1,2)=(0D0,0D0)
0338           ZTC(1,3)=DCMPLX(UH*XIG,0D0)
0339           ZTC(1,4)=ZTC(1,3)
0340           ZTC(1,5)=ZTC(1,2)
0341           ZTC(1,6)=ZTC(1,2)
0342           ZTC(2,3)=DCMPLX(UH*XIG*X11,0D0)
0343           ZTC(2,4)=DCMPLX(UH*XIG*X22,0D0)
0344           ZTC(2,5)=DCMPLX(UH*XIG*X12,0D0)
0345           ZTC(2,6)=DCMPLX(UH*XIG*X21,0D0)
0346           ZTC(3,4)=-SM1122
0347           ZTC(3,5)=-SM1112
0348           ZTC(3,6)=-SM1121
0349           ZTC(4,5)=-SM2212
0350           ZTC(4,6)=-SM2221
0351           ZTC(5,6)=-SM1221
0352           DO 210 I=1,5
0353             DO 200 J=I+1,6
0354                ZTC(J,I)=ZTC(I,J)
0355   200       CONTINUE
0356   210     CONTINUE
0357           CALL PYLDCM(ZTC,6,6,INDX,D)
0358           DO 230 I=1,6
0359             DO 220 J=1,6
0360               YTC(I,J)=(0D0,0D0)
0361               IF(I.EQ.J) YTC(I,J)=(1D0,0D0)
0362   220       CONTINUE
0363   230     CONTINUE
0364           DO 240 I=1,6
0365             CALL PYBKSB(ZTC,6,6,INDX,YTC(1,I))
0366   240     CONTINUE
0367           DGGU=YTC(1,1)
0368           DVVU=YTC(2,2)
0369           DGVU=YTC(1,2)
0370
0371           IF(IMDL.EQ.1) THEN
0372             DQQS=DGGS+DVVS*DCMPLX(TANT3**2)-DGVS*DCMPLX(2D0*TANT3)
0373             DQQT=DGGT+DVVT*DCMPLX(TANT3**2)-DGVT*DCMPLX(2D0*TANT3)
0374             DQQU=DGGU+DVVU*DCMPLX(TANT3**2)-DGVU*DCMPLX(2D0*TANT3)
0375             DQTS=DGGS-DVVS-DGVS*DCMPLX(TANT3-1D0/TANT3)
0376             DQGS=DGGS-DGVS*DCMPLX(TANT3)
0377             DTGS=DGGS+DGVS*DCMPLX(1D0/TANT3)
0378           ELSE
0379             DQQS=DGGS+DVVS*DCMPLX(1D0/TANT3**2)+DGVS*DCMPLX(2D0/TANT3)
0380             DQQT=DGGT+DVVT*DCMPLX(1D0/TANT3**2)+DGVT*DCMPLX(2D0/TANT3)
0381             DQQU=DGGU+DVVU*DCMPLX(1D0/TANT3**2)+DGVU*DCMPLX(2D0/TANT3)
0382             DQTS=DGGS+DVVS*DCMPLX(1D0/TANT3**2)+DGVS*DCMPLX(2D0/TANT3)
0383             DQGS=DGGS+DGVS*DCMPLX(1D0/TANT3)
0384             DTGS=DGGS+DGVS*DCMPLX(1D0/TANT3)
0385           ENDIF
0386
0387           SQDQTS=ABS(DQTS)**2
0388           SQDQQS=ABS(DQQS)**2
0389           SQDQQT=ABS(DQQT)**2
0390           SQDQQU=ABS(DQQU)**2
0391           SQDLGS=ABS(DCMPLX(SH)*DQGS-DCMPLX(1D0))**2
0392           REDLGS=DBLE(DQGS)
0393           SQDHGS=ABS(DCMPLX(SH)*DTGS-DCMPLX(1D0))**2
0394           REDHGS=DBLE(DTGS)
0395           SQDLGT=ABS(DCMPLX(TH)*DGGT-DCMPLX(1D0))**2
0396
0397           SQDGGS=ABS(DGGS)**2
0398           SQDGGT=ABS(DGGT)**2
0399           SQDGGU=ABS(DGGU)**2
0400           REDGGS=DBLE(DGGS)
0401           REDGGT=DBLE(DGGT)
0402           REDGGU=DBLE(DGGU)
0403           REDGTU=DBLE(DGGU*DCONJG(DGGT))
0404           REDGSU=DBLE(DGGU*DCONJG(DGGS))
0405           REDGST=DBLE(DGGS*DCONJG(DGGT))
0406           REDQST=DBLE(DQQS*DCONJG(DQQT))
0407           REDQTU=DBLE(DQQT*DCONJG(DQQU))
0408         ENDIF
0409       ENDIF
0410
0411
0412 C...Differential cross section expressions.
0413
0414       IF(ISUB.LE.190) THEN
0415         IF(ISUB.EQ.149) THEN
0416 C...g + g -> eta_tc
0417           KCTC=PYCOMP(KTECHN+331)
0418           CALL PYWIDT(KTECHN+331,SH,WDTP,WDTE)
0419           HS=SHR*WDTP(0)
0420           FACBW=COMFAC*0.5D0/((SH-PMAS(KCTC,1)**2)**2+HS**2)
0421           IF(ABS(SHR-PMAS(KCTC,1)).GT.PARP(48)*PMAS(KCTC,2)) FACBW=0D0
0422           HP=SH
0423           IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 250
0424           HI=HP*WDTP(3)
0425           HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
0426           NCHN=NCHN+1
0427           ISIG(NCHN,1)=21
0428           ISIG(NCHN,2)=21
0429           ISIG(NCHN,3)=1
0430           SIGH(NCHN)=HI*FACBW*HF
0431   250     CONTINUE
0432
0433         ELSEIF(ISUB.EQ.165) THEN
0434 C...q + qbar -> l+ + l- (including contact term for compositeness)
0435           ZRATR=XWC*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2)
0436           ZRATI=XWC*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2)
0437           KFF=IABS(KFPR(ISUB,1))
0438           EF=KCHG(KFF,1)/3D0
0439           AF=SIGN(1D0,EF+0.1D0)
0440           VF=AF-4D0*EF*XWV
0441           VALF=VF+AF
0442           VARF=VF-AF
0443           FCOF=1D0
0444           IF(KFF.LE.10) FCOF=3D0
0445           WID2=1D0
0446           IF(KFF.EQ.6) WID2=WIDS(6,1)
0447           IF(KFF.EQ.7.OR.KFF.EQ.8) WID2=WIDS(KFF,1)
0448           IF(KFF.EQ.17.OR.KFF.EQ.18) WID2=WIDS(KFF,1)
0449           DO 260 I=MMINA,MMAXA
0450             IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 260
0451             EI=KCHG(IABS(I),1)/3D0
0452             AI=SIGN(1D0,EI+0.1D0)
0453             VI=AI-4D0*EI*XWV
0454             VALI=VI+AI
0455             VARI=VI-AI
0456             FCOI=1D0
0457             IF(IABS(I).LE.10) FCOI=FACA/3D0
0458             IF((ITCM(5).EQ.1.AND.IABS(I).LE.2).OR.ITCM(5).EQ.2) THEN
0459               FGZA=(EI*EF+VALI*VALF*ZRATR+RTCM(42)*SH/
0460      &        (AEM*RTCM(41)**2))**2+(VALI*VALF*ZRATI)**2+
0461      &        (EI*EF+VARI*VARF*ZRATR)**2+(VARI*VARF*ZRATI)**2
0462             ELSE
0463               FGZA=(EI*EF+VALI*VALF*ZRATR)**2+(VALI*VALF*ZRATI)**2+
0464      &        (EI*EF+VARI*VARF*ZRATR)**2+(VARI*VARF*ZRATI)**2
0465             ENDIF
0466             FGZB=(EI*EF+VALI*VARF*ZRATR)**2+(VALI*VARF*ZRATI)**2+
0467      &      (EI*EF+VARI*VALF*ZRATR)**2+(VARI*VALF*ZRATI)**2
0468             FGZAB=AEM**2*(FGZA*UH2/SH2+FGZB*TH2/SH2)
0469             IF((ITCM(5).EQ.3.AND.IABS(I).EQ.2).OR.(ITCM(5).EQ.4.AND.
0470      &      MOD(IABS(I),2).EQ.0)) FGZAB=FGZAB+SH2/(2D0*RTCM(41)**4)
0471             NCHN=NCHN+1
0472             ISIG(NCHN,1)=I
0473             ISIG(NCHN,2)=-I
0474             ISIG(NCHN,3)=1
0475             SIGH(NCHN)=COMFAC*FCOI*FCOF*FGZAB*WID2
0476   260     CONTINUE
0477
0478         ELSEIF(ISUB.EQ.166) THEN
0479 C...q + q'bar -> l + nu_l (including contact term for compositeness)
0480           WFAC=(1D0/4D0)*(AEM/XW)**2*UH2/((SH-SQMW)**2+GMMW**2)
0481           WCIFAC=WFAC+SH2/(4D0*RTCM(41)**4)
0482           KFF=IABS(KFPR(ISUB,1))
0483           FCOF=1D0
0484           IF(KFF.LE.10) FCOF=3D0
0485           DO 280 I=MMIN1,MMAX1
0486             IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 280
0487             IA=IABS(I)
0488             DO 270 J=MMIN2,MMAX2
0489               IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 270
0490               JA=IABS(J)
0491               IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 270
0492               IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10))
0493      &        GOTO 270
0494               FCOI=1D0
0495               IF(IA.LE.10) FCOI=VCKM((IA+1)/2,(JA+1)/2)*FACA/3D0
0496               WID2=1D0
0497               IF((I.GT.0.AND.MOD(I,2).EQ.0).OR.(J.GT.0.AND.
0498      &        MOD(J,2).EQ.0)) THEN
0499                 IF(KFF.EQ.5) WID2=WIDS(6,2)
0500                 IF(KFF.EQ.7) WID2=WIDS(8,2)*WIDS(7,3)
0501                 IF(KFF.EQ.17) WID2=WIDS(18,2)*WIDS(17,3)
0502               ELSE
0503                 IF(KFF.EQ.5) WID2=WIDS(6,3)
0504                 IF(KFF.EQ.7) WID2=WIDS(8,3)*WIDS(7,2)
0505                 IF(KFF.EQ.17) WID2=WIDS(18,3)*WIDS(17,2)
0506               ENDIF
0507               NCHN=NCHN+1
0508               ISIG(NCHN,1)=I
0509               ISIG(NCHN,2)=J
0510               ISIG(NCHN,3)=1
0511               SIGH(NCHN)=COMFAC*FCOI*FCOF*WFAC*WID2
0512               IF((ITCM(5).EQ.3.AND.IA.LE.2.AND.JA.LE.2).OR.ITCM(5).EQ.4)
0513      &        SIGH(NCHN)=COMFAC*FCOI*FCOF*WCIFAC*WID2
0514   270       CONTINUE
0515   280     CONTINUE
0516         ENDIF
0517
0518       ELSEIF(ISUB.LE.200) THEN
0519         IF(ISUB.EQ.191) THEN
0520 C...q + qbar -> rho_tc0.
0521           KCTC=PYCOMP(KTECHN+113)
0522           SQMRHT=PMAS(KCTC,1)**2
0523           CALL PYWIDT(KTECHN+113,SH,WDTP,WDTE)
0524           HS=SHR*WDTP(0)
0525           FACBW=12D0*COMFAC/((SH-SQMRHT)**2+HS**2)
0526           IF(ABS(SHR-PMAS(KCTC,1)).GT.PARP(48)*PMAS(KCTC,2)) FACBW=0D0
0527           HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
0528           ALPRHT=2.91D0*(3D0/ITCM(1))
0529           HP=(1D0/6D0)*(AEM**2/ALPRHT)*(SQMRHT**2/SH)
0530           XWRHT=(1D0-2D0*XW)/(4D0*XW*(1D0-XW))
0531           BWZR=XWRHT*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2)
0532           BWZI=XWRHT*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2)
0533           DO 290 I=MMINA,MMAXA
0534             IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 290
0535             IA=IABS(I)
0536             EI=KCHG(IABS(I),1)/3D0
0537             AI=SIGN(1D0,EI+0.1D0)
0538             VI=AI-4D0*EI*XWV
0539             VALI=0.5D0*(VI+AI)
0540             VARI=0.5D0*(VI-AI)
0541             HI=HP*((EI+VALI*BWZR)**2+(VALI*BWZI)**2+
0542      &      (EI+VARI*BWZR)**2+(VARI*BWZI)**2)
0543             IF(IA.LE.10) HI=HI*FACA/3D0
0544             NCHN=NCHN+1
0545             ISIG(NCHN,1)=I
0546             ISIG(NCHN,2)=-I
0547             ISIG(NCHN,3)=1
0548             SIGH(NCHN)=HI*FACBW*HF
0549   290     CONTINUE
0550
0551         ELSEIF(ISUB.EQ.192) THEN
0552 C...q + qbar' -> rho_tc+/-.
0553           KCTC=PYCOMP(KTECHN+213)
0554           SQMRHT=PMAS(KCTC,1)**2
0555           CALL PYWIDT(KTECHN+213,SH,WDTP,WDTE)
0556           HS=SHR*WDTP(0)
0557           FACBW=12D0*COMFAC/((SH-SQMRHT)**2+HS**2)
0558           IF(ABS(SHR-PMAS(KCTC,1)).GT.PARP(48)*PMAS(KCTC,2)) FACBW=0D0
0559           ALPRHT=2.91D0*(3D0/ITCM(1))
0560           HP=(1D0/6D0)*(AEM**2/ALPRHT)*(SQMRHT**2/SH)*
0561      &    (0.25D0/XW**2)*SH**2/((SH-SQMW)**2+GMMW**2)
0562           DO 310 I=MMIN1,MMAX1
0563             IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 310
0564             IA=IABS(I)
0565             DO 300 J=MMIN2,MMAX2
0566               IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 300
0567               JA=IABS(J)
0568               IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 300
0569               IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10))
0570      &        GOTO 300
0571               KCHR=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
0572               HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHR)/2)+WDTE(0,4))
0573               HI=HP
0574               IF(IA.LE.10) HI=HI*VCKM((IA+1)/2,(JA+1)/2)*FACA/3D0
0575               NCHN=NCHN+1
0576               ISIG(NCHN,1)=I
0577               ISIG(NCHN,2)=J
0578               ISIG(NCHN,3)=1
0579               SIGH(NCHN)=HI*FACBW*HF
0580   300       CONTINUE
0581   310     CONTINUE
0582
0583         ELSEIF(ISUB.EQ.193) THEN
0584 C...q + qbar -> omega_tc0.
0585           KCTC=PYCOMP(KTECHN+223)
0586           SQMOMT=PMAS(KCTC,1)**2
0587           CALL PYWIDT(KTECHN+223,SH,WDTP,WDTE)
0588           HS=SHR*WDTP(0)
0589           FACBW=12D0*COMFAC/((SH-SQMOMT)**2+HS**2)
0590           IF(ABS(SHR-PMAS(KCTC,1)).GT.PARP(48)*PMAS(KCTC,2)) FACBW=0D0
0591           HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
0592           ALPRHT=2.91D0*(3D0/ITCM(1))
0593           HP=(1D0/6D0)*(AEM**2/ALPRHT)*(SQMOMT**2/SH)*
0594      &    (2D0*RTCM(2)-1D0)**2
0595           BWZR=(0.5D0/(1D0-XW))*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2)
0596           BWZI=(0.5D0/(1D0-XW))*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2)
0597           DO 320 I=MMINA,MMAXA
0598             IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 320
0599             IA=IABS(I)
0600             EI=KCHG(IABS(I),1)/3D0
0601             AI=SIGN(1D0,EI+0.1D0)
0602             VI=AI-4D0*EI*XWV
0603             VALI=0.5D0*(VI+AI)
0604             VARI=0.5D0*(VI-AI)
0605             HI=HP*((EI-VALI*BWZR)**2+(VALI*BWZI)**2+
0606      &      (EI-VARI*BWZR)**2+(VARI*BWZI)**2)
0607             IF(IA.LE.10) HI=HI*FACA/3D0
0608             NCHN=NCHN+1
0609             ISIG(NCHN,1)=I
0610             ISIG(NCHN,2)=-I
0611             ISIG(NCHN,3)=1
0612             SIGH(NCHN)=HI*FACBW*HF
0613   320     CONTINUE
0614
0615         ELSEIF(ISUB.EQ.194) THEN
0616 C...f + fbar -> f' + fbar' via s-channel rho_tc and omega_tc.
0617           KFA=KFPR(ISUBSV,1)
0618           ALPRHT=2.91D0*(3D0/ITCM(1))
0619           HP=AEM**2*COMFAC
0620           TANW=SQRT(PARU(102)/(1D0-PARU(102)))
0621           CT2W=(1D0-2D0*PARU(102))/(2D0*PARU(102)/TANW)
0622
0623           QUPD=2D0*RTCM(2)-1D0
0624           FAR=SQRT(AEM/ALPRHT)
0625           FAO=FAR*QUPD
0626           FZR=FAR*CT2W
0627           FZO=-FAO*TANW
0628           SFAR=FAR**2
0629           SFAO=FAO**2
0630           SFZR=FZR**2
0631           SFZO=FZO**2
0632           CALL PYWIDT(23,SH,WDTP,WDTE)
0633           SSMZ=DCMPLX(1D0-PMAS(23,1)**2/SH,WDTP(0)/SHR)
0634           CALL PYWIDT(KTECHN+113,SH,WDTP,WDTE)
0635           SSMR=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+113),1)**2/SH,WDTP(0)/SHR)
0636           CALL PYWIDT(KTECHN+223,SH,WDTP,WDTE)
0637           SSMO=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+223),1)**2/SH,WDTP(0)/SHR)
0638           DETD=(FAR*FZO-FAO*FZR)**2+SSMZ*SSMR*SSMO-SFZR*SSMO-
0639      $    SFZO*SSMR-SFAR*SSMO*SSMZ-SFAO*SSMR*SSMZ
0640           DAA=(-Sfzr*SSMO - Sfzo*SSMR + SSMO*SSMR*SSMZ)/DETD/SH
0641           DZZ=(-Sfar*SSMO - Sfao*SSMR + SSMO*SSMR)/DETD/SH
0642           DAZ=(far*fzr*SSMO + fao*fzo*SSMR)/DETD/SH
0643
0644           XWRHT=1D0/(4D0*XW*(1D0-XW))
0645           KFF=IABS(KFPR(ISUB,1))
0646           EF=KCHG(KFF,1)/3D0
0647           AF=SIGN(1D0,EF+0.1D0)
0648           VF=AF-4D0*EF*XWV
0649           VALF=0.5D0*(VF+AF)
0650           VARF=0.5D0*(VF-AF)
0651           FCOF=1D0
0652           IF(KFF.LE.10) FCOF=3D0
0653
0654           WID2=1D0
0655           IF(KFF.GE.6.AND.KFF.LE.8) WID2=WIDS(KFF,1)
0656           IF(KFF.EQ.17.OR.KFF.EQ.18) WID2=WIDS(KFF,1)
0657           DZZ=DZZ*DCMPLX(XWRHT,0D0)
0658           DAZ=DAZ*DCMPLX(SQRT(XWRHT),0D0)
0659
0660           DO 330 I=MMINA,MMAXA
0661             IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 330
0662             EI=KCHG(IABS(I),1)/3D0
0663             AI=SIGN(1D0,EI+0.1D0)
0664             VI=AI-4D0*EI*XWV
0665             VALI=0.5D0*(VI+AI)
0666             VARI=0.5D0*(VI-AI)
0667             FCOI=FCOF
0668             IF(IABS(I).LE.10) FCOI=FCOI/3D0
0669             DIFLL=ABS(EI*EF*DAA+VALI*VALF*DZZ+DAZ*(EI*VALF+EF*VALI))**2
0670             DIFRR=ABS(EI*EF*DAA+VARI*VARF*DZZ+DAZ*(EI*VARF+EF*VARI))**2
0671             DIFLR=ABS(EI*EF*DAA+VALI*VARF*DZZ+DAZ*(EI*VARF+EF*VALI))**2
0672             DIFRL=ABS(EI*EF*DAA+VARI*VALF*DZZ+DAZ*(EI*VALF+EF*VARI))**2
0673             FACSIG=(DIFLL+DIFRR)*((UH-SQM4)**2+SH*SQM4)+
0674      &      (DIFLR+DIFRL)*((TH-SQM3)**2+SH*SQM3)
0675             NCHN=NCHN+1
0676             ISIG(NCHN,1)=I
0677             ISIG(NCHN,2)=-I
0678             ISIG(NCHN,3)=1
0679             SIGH(NCHN)=HP*FCOI*FACSIG*WID2
0680   330     CONTINUE
0681
0682         ELSEIF(ISUB.EQ.195) THEN
0683 C...f + fbar' -> f'' + fbar''' via s-channel rho_tc+
0684           KFA=KFPR(ISUBSV,1)
0685           KFB=KFA+1
0686           ALPRHT=2.91D0*(3D0/ITCM(1))
0687           FACTC=COMFAC*(AEM**2/12D0/XW**2)*(UH-SQM3)*(UH-SQM4)*3D0
0688
0689           FWR=SQRT(AEM/ALPRHT)/(2D0*SQRT(XW))
0690           CALL PYWIDT(24,SH,WDTP,WDTE)
0691           SSMZ=DCMPLX(1D0-PMAS(24,1)**2/SH,WDTP(0)/SHR)
0692           CALL PYWIDT(KTECHN+213,SH,WDTP,WDTE)
0693           SSMR=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+213),1)**2/SH,WDTP(0)/SHR)
0694
0695           FCOF=1D0
0696           IF(KFA.LE.8) FCOF=3D0
0697           DETD=SSMZ*SSMR-DCMPLX(FWR**2,0D0)
0698           HP=FACTC*ABS(SSMR/DETD)**2/SH**2*FCOF
0699
0700           DO 350 I=MMIN1,MMAX1
0701             IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 350
0702             IA=IABS(I)
0703             DO 340 J=MMIN2,MMAX2
0704               IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 340
0705               JA=IABS(J)
0706               IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 340
0707               IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10))
0708      &        GOTO 340
0709               KCHR=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
0710               HI=HP
0711               IF(IA.LE.10) HI=HI*VCKM((IA+1)/2,(JA+1)/2)/3D0
0712               NCHN=NCHN+1
0713               ISIG(NCHN,1)=I
0714               ISIG(NCHN,2)=J
0715               ISIG(NCHN,3)=1
0716               SIGH(NCHN)=HI*WIDS(KFA,(5-KCHR)/2)*WIDS(KFB,(5+KCHR)/2)
0717   340       CONTINUE
0718   350     CONTINUE
0719         ENDIF
0720
0721       ELSEIF(ISUB.LE.380) THEN
0722         IF(ISUB.EQ.361) THEN
0723 C...f + fbar -> W_L W_L, W_L pi_tc, pi_tc pi_tc
0724           FACA=(SH**2*BE34**2-(TH-UH)**2)
0725           ALPRHT=2.91D0*(3D0/ITCM(1))
0726           HP=(1D0/12D0)*AEM**2*CAB2*COMFAC*FACA*3D0
0727           FAR=SQRT(AEM/ALPRHT)
0728           FAO=FAR*QUPD
0729           FZR=FAR*CT2W
0730           FZO=-FAO*TANW
0731           SFAR=FAR**2
0732           SFAO=FAO**2
0733           SFZR=FZR**2
0734           SFZO=FZO**2
0735           CALL PYWIDT(23,SH,WDTP,WDTE)
0736           SSMZ=DCMPLX(1D0-PMAS(23,1)**2/SH,WDTP(0)/SHR)
0737           CALL PYWIDT(KTECHN+113,SH,WDTP,WDTE)
0738           SSMR=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+113),1)**2/SH,WDTP(0)/SHR)
0739           CALL PYWIDT(KTECHN+223,SH,WDTP,WDTE)
0740           SSMO=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+223),1)**2/SH,WDTP(0)/SHR)
0741           DETD=(FAR*FZO-FAO*FZR)**2+SSMZ*SSMR*SSMO-SFZR*SSMO-
0742      $    SFZO*SSMR-SFAR*SSMO*SSMZ-SFAO*SSMR*SSMZ
0743           DARHO=-(-FAR*SFZO+FAO*FZO*FZR+FAR*SSMO*SSMZ)/DETD/SH
0744           DZRHO=-(-FZR*SFAO+FAO*FZO*FAR+FZR*SSMO)/DETD/SH
0745           DAA=-(SFZO*SSMR+SFZR*SSMO-SSMO*SSMR*SSMZ)/DETD/SH
0746           DZZ=-(SFAO*SSMR+SFAR*SSMO-SSMO*SSMR)/DETD/SH
0747           DAZ=(FAR*FZR*SSMO+FAO*FZO*SSMR)/DETD/SH
0748
0749           DO 360 I=MMINA,MMAXA
0750             IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 360
0751             IA=IABS(I)
0752             EI=KCHG(IABS(I),1)/3D0
0753             AI=SIGN(1D0,EI+0.1D0)
0754             VI=AI-4D0*EI*XWV
0755             VALI=0.25D0*(VI+AI)
0756             VARI=0.25D0*(VI-AI)
0757             F2L=EI*(DARHO/FAR+DAA+CT2W*DAZ)+
0758      $      VALI*(CT2W*DZRHO/FZR+CT2W*DZZ+DAZ)/SQRT(XW*XW1)
0759             F2R=EI*(DARHO/FAR+DAA+CT2W*DAZ)+
0760      $      VARI*(CT2W*DZRHO/FZR+CT2W*DZZ+DAZ)/SQRT(XW*XW1)
0761             HI=ABS(F2L)**2+ABS(F2R)**2
0762             IF(IA.LE.10) HI=HI/3D0
0763             NCHN=NCHN+1
0764             ISIG(NCHN,1)=I
0765             ISIG(NCHN,2)=-I
0766             ISIG(NCHN,3)=1
0767             IF(KFA.EQ.KFB) THEN
0768                SIGH(NCHN)=HI*HP*WIDS(PYCOMP(KFA),1)
0769             ELSE
0770                SIGH(NCHN)=HI*HP*WIDS(PYCOMP(KFA),2)*WIDS(PYCOMP(KFB),3)
0771                NCHN=NCHN+1
0772                ISIG(NCHN,1)=I
0773                ISIG(NCHN,2)=-I
0774                ISIG(NCHN,3)=2
0775                SIGH(NCHN)=HI*HP*WIDS(PYCOMP(KFA),3)*WIDS(PYCOMP(KFB),2)
0776             ENDIF
0777   360     CONTINUE
0778
0779         ELSEIF(ISUB.EQ.364) THEN
0780 C...f + fbar -> gamma pi_tc, gamma pi_tc', Z pi_tc, Z pi_tc',
0781 C...W pi_tc
0782           VFAC=(TH**2+UH**2-2D0*SQM3*SQM4)
0783           AFAC=(TH**2+UH**2-2D0*SQM3*SQM4+4D0*SH*SQM3)
0784           FANOM=SQRT(PARU(1)*AEM)*ITCM(1)/PARU(2)**2/RTCM(1)
0785
0786           ALPRHT=2.91D0*(3D0/ITCM(1))
0787           HP=(1D0/24D0)*AEM**2*COMFAC*3D0*SH
0788           FAR=SQRT(AEM/ALPRHT)
0789           FAO=FAR*QUPD
0790           FZR=FAR*CT2W
0791           FZO=-FAO*TANW
0792           SFAR=FAR**2
0793           SFAO=FAO**2
0794           SFZR=FZR**2
0795           SFZO=FZO**2
0796           CALL PYWIDT(23,SH,WDTP,WDTE)
0797           SSMZ=DCMPLX(1D0-PMAS(23,1)**2/SH,WDTP(0)/SHR)
0798           CALL PYWIDT(KTECHN+113,SH,WDTP,WDTE)
0799           SSMR=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+113),1)**2/SH,WDTP(0)/SHR)
0800           CALL PYWIDT(KTECHN+223,SH,WDTP,WDTE)
0801           SSMO=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+223),1)**2/SH,WDTP(0)/SHR)
0802           DETD=(FAR*FZO-FAO*FZR)**2+SSMZ*SSMR*SSMO-SFZR*SSMO-
0803      $    SFZO*SSMR-SFAR*SSMO*SSMZ-SFAO*SSMR*SSMZ
0804           DARHO=(-FAR*SFZO+FAO*FZO*FZR+FAR*SSMO*SSMZ)/DETD/SH
0805           DZRHO=(-FZR*SFAO+FAO*FZO*FAR+FZR*SSMO)/DETD/SH
0806           DAOME=(-FAO*SFZR+FAR*FZO*FZR+FAO*SSMR*SSMZ)/DETD/SH
0807           DZOME=(-FZO*SFAR+FAR*FAO*FZR+FZO*SSMR)/DETD/SH
0808           DAA=(SFZO*SSMR+SFZR*SSMO-SSMO*SSMR*SSMZ)/DETD/SH
0809           DZZ=(SFAO*SSMR+SFAR*SSMO-SSMO*SSMR)/DETD/SH
0810           DAZ=(FAR*FZR*SSMO+FAO*FZO*SSMR)/DETD/SH
0811
0812           DO 370 I=MMINA,MMAXA
0813             IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 370
0814             IA=IABS(I)
0815             EI=KCHG(IABS(I),1)/3D0
0816             AI=SIGN(1D0,EI+0.1D0)
0817             VI=AI-4D0*EI*XWV
0818             VALI=0.25D0*(VI+AI)
0819             VARI=0.25D0*(VI-AI)
0820 C...........Add in anomaly contribution
0821             F2L=(EI*DARHO+VALI*DZRHO/SQRT(XW*XW1))*VRGP
0822             F2L=F2L+(EI*DAOME+VALI*DZOME/SQRT(XW*XW1))*VOGP
0823             F2L=F2L+FANOM*(VAGP*(EI*DAA+VALI*DAZ/SQRT(XW*XW1))+
0824      $                    VZGP*(EI*DAZ+VALI*DZZ/SQRT(XW*XW1)))
0825             F2R=(EI*DARHO+VARI*DZRHO/SQRT(XW*XW1))*VRGP
0826             F2R=F2R+(EI*DAOME+VARI*DZOME/SQRT(XW*XW1))*VOGP
0827             F2R=F2R+FANOM*(VAGP*(EI*DAA+VARI*DAZ/SQRT(XW*XW1))+
0828      $                    VZGP*(EI*DAZ+VARI*DZZ/SQRT(XW*XW1)))
0829             HI=(ABS(F2L)**2+ABS(F2R)**2)*VFAC
0830             F2L=(EI*DARHO+VALI*DZRHO/SQRT(XW*XW1))*ARGP
0831             F2L=F2L+(EI*DAOME+VALI*DZOME/SQRT(XW*XW1))*AOGP
0832             F2R=(EI*DARHO+VARI*DZRHO/SQRT(XW*XW1))*ARGP
0833             F2R=F2R+(EI*DAOME+VARI*DZOME/SQRT(XW*XW1))*AOGP
0834             HJ=(ABS(F2L)**2+ABS(F2R)**2)*AFAC
0835             HI=HI+HJ
0836             IF(IA.LE.10) HI=HI/3D0
0837             NCHN=NCHN+1
0838             ISIG(NCHN,1)=I
0839             ISIG(NCHN,2)=-I
0840             ISIG(NCHN,3)=1
0841             IF(ISUBSV.NE.368) THEN
0842                SIGH(NCHN)=HI*HP*WIDS(PYCOMP(KFA),2)*WIDS(PYCOMP(KFB),2)
0843             ELSE
0844                SIGH(NCHN)=HI*HP*WIDS(PYCOMP(KFA),2)*WIDS(PYCOMP(KFB),3)
0845                NCHN=NCHN+1
0846                ISIG(NCHN,1)=I
0847                ISIG(NCHN,2)=-I
0848                ISIG(NCHN,3)=2
0849                SIGH(NCHN)=HI*HP*WIDS(PYCOMP(KFA),3)*WIDS(PYCOMP(KFB),2)
0850             ENDIF
0851   370     CONTINUE
0852
0853         ELSEIF(ISUB.EQ.370) THEN
0854 C...f + fbar' -> W_L Z_L, W_L pi_tc, Z_L pi_tc, pi_tc pi_tc
0855
0856           FACA=(SH**2*BE34**2-(TH-UH)**2)
0857           ALPRHT=2.91D0*(3D0/ITCM(1))
0858           HP=(1D0/96D0)*AEM**2*CAB2*COMFAC*FACA*3D0/XW**2
0859           FWR=SQRT(AEM/ALPRHT)/(2D0*SQRT(XW))
0860           CALL PYWIDT(24,SH,WDTP,WDTE)
0861           SSMZ=DCMPLX(1D0-PMAS(24,1)**2/SH,WDTP(0)/SHR)
0862           CALL PYWIDT(KTECHN+213,SH,WDTP,WDTE)
0863           SSMR=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+213),1)**2/SH,WDTP(0)/SHR)
0864           DETD=SSMZ*SSMR-DCMPLX(FWR**2,0D0)
0865           DWW=SSMR/DETD/SH
0866           DWRHO=-1D0/DETD/SH
0867           HP=HP*ABS(DWW+DWRHO)**2
0868           DO 390 I=MMIN1,MMAX1
0869             IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 390
0870             IA=IABS(I)
0871             DO 380 J=MMIN2,MMAX2
0872               IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 380
0873               JA=IABS(J)
0874               IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 380
0875               IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10))
0876      &        GOTO 380
0877               KCHR=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
0878               HI=HP
0879               IF(IA.LE.10) HI=HI*VCKM((IA+1)/2,(JA+1)/2)/3D0
0880               NCHN=NCHN+1
0881               ISIG(NCHN,1)=I
0882               ISIG(NCHN,2)=J
0883               ISIG(NCHN,3)=1
0884               SIGH(NCHN)=HI*WIDS(PYCOMP(KFA),(5-KCHR)/2)*
0885      &        WIDS(PYCOMP(KFB),2)
0886   380       CONTINUE
0887   390     CONTINUE
0888
0889         ELSEIF(ISUB.EQ.374) THEN
0890 C...f + fbar' -> gamma pi_tc
0891           FANOM=SQRT(AEM)*ITCM(1)/2D0/PARU(2)/RTCM(1)
0892           VFAC=(TH**2+UH**2-2D0*SQM3*SQM4)
0893           AFAC=(TH**2+UH**2-2D0*SQM3*SQM4+4D0*SH*SQM3)/SQTA*ARGP**2
0894           ALPRHT=2.91D0*(3D0/ITCM(1))
0895           HP=(1D0/48D0)*AEM**2/XW*COMFAC*3D0*SH
0896           FWR=SQRT(AEM/ALPRHT)/(2D0*SQRT(XW))
0897           CALL PYWIDT(24,SH,WDTP,WDTE)
0898           SSMZ=DCMPLX(1D0-PMAS(24,1)**2/SH,WDTP(0)/SHR)
0899           CALL PYWIDT(KTECHN+213,SH,WDTP,WDTE)
0900           SSMR=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+213),1)**2/SH,WDTP(0)/SHR)
0901           DETD=SSMZ*SSMR-DCMPLX(FWR**2,0D0)
0902           DWW=SSMR/DETD/SH
0903           DWRHO=-DCMPLX(FWR,0D0)/DETD/SH
0904           HP=HP*(AFAC*ABS(DWRHO)**2+
0905      $    VFAC*ABS(FANOM*DWW*VWGP+DWRHO*VRGP/SQRT(SQTV))**2)
0906           DO 410 I=MMIN1,MMAX1
0907             IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 410
0908             IA=IABS(I)
0909             DO 400 J=MMIN2,MMAX2
0910               IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 400
0911               JA=IABS(J)
0912               IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 400
0913               IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10))
0914      &        GOTO 400
0915               KCHR=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
0916               HI=HP
0917               IF(IA.LE.10) HI=HI*VCKM((IA+1)/2,(JA+1)/2)/3D0
0918               NCHN=NCHN+1
0919               ISIG(NCHN,1)=I
0920               ISIG(NCHN,2)=J
0921               ISIG(NCHN,3)=1
0922               SIGH(NCHN)=HI*WIDS(PYCOMP(KFA),(5-KCHR)/2)*
0923      &        WIDS(PYCOMP(KFB),2)
0924   400       CONTINUE
0925   410     CONTINUE
0926         ENDIF
0927
0928       ELSEIF(ISUB.LE.390) THEN
0929         IF(ISUB.EQ.381) THEN
0930 C...f + f' -> f + f' (g exchange)
0931           FACQQ1=COMFAC*AS**2*4D0/9D0*(SH2+UH2)*SQDQQT
0932           FACQQB=COMFAC*AS**2*4D0/9D0*((SH2+UH2)*SQDQQT*FACA-
0933      &    MSTP(34)*2D0/3D0*UH2*REDQST)
0934           FACQQ2=COMFAC*AS**2*4D0/9D0*(SH2+TH2)*SQDQQU
0935           FACQQI=-COMFAC*AS**2*4D0/9D0*MSTP(34)*2D0/3D0*SH2/(TH*UH)
0936           RATQQI=(FACQQ1+FACQQ2+FACQQI)/(FACQQ1+FACQQ2)
0937           IF(ITCM(5).GE.1.AND.ITCM(5).LE.4) THEN
0938 C...Modifications from contact interactions (compositeness)
0939             FACCI1=FACQQ1+COMFAC*(SH2/RTCM(41)**4)
0940             FACCIB=FACQQB+COMFAC*(8D0/9D0)*(AS*RTCM(42)/RTCM(41)**2)*
0941      &      (UH2/TH+UH2/SH)+COMFAC*(5D0/3D0)*(UH2/RTCM(41)**4)
0942             FACCI2=FACQQ2+COMFAC*(8D0/9D0)*(AS*RTCM(42)/RTCM(41)**2)*
0943      &      (SH2/TH+SH2/UH)+COMFAC*(5D0/3D0)*(SH2/RTCM(41)**4)
0944             FACCI3=FACQQ1+COMFAC*(UH2/RTCM(41)**4)
0945             RATCII=(FACCI1+FACCI2+FACQQI)/(FACCI1+FACCI2)
0946           ELSEIF(ITCM(5).EQ.5) THEN
0947             FACCI1=FACQQ1
0948             FACCIB=FACQQB
0949             FACCI2=FACQQ2
0950             FACCI3=FACQQ1
0951 CSM.......Check this change from
0952 CSM            RATCII=1D0
0953             RATCII=RATQQI
0954           ENDIF
0955           DO 430 I=MMIN1,MMAX1
0956             IA=IABS(I)
0957             IF(I.EQ.0.OR.IA.GT.MSTP(58).OR.KFAC(1,I).EQ.0) GOTO 430
0958             DO 420 J=MMIN2,MMAX2
0959               JA=IABS(J)
0960               IF(J.EQ.0.OR.JA.GT.MSTP(58).OR.KFAC(2,J).EQ.0) GOTO 420
0961               NCHN=NCHN+1
0962               ISIG(NCHN,1)=I
0963               ISIG(NCHN,2)=J
0964               ISIG(NCHN,3)=1
0965               IF(ITCM(5).LE.0.OR.(ITCM(5).EQ.1.AND.(IA.GE.3.OR.
0966      &        JA.GE.3))) THEN
0967                 SIGH(NCHN)=FACQQ1
0968                 IF(I.EQ.-J) SIGH(NCHN)=FACQQB
0969               ELSE
0970                 SIGH(NCHN)=FACCI1
0971                 IF(I*J.LT.0) SIGH(NCHN)=FACCI3
0972                 IF(I.EQ.-J) SIGH(NCHN)=FACCIB
0973               ENDIF
0974               IF(I.EQ.J) THEN
0975                 NCHN=NCHN+1
0976                 ISIG(NCHN,1)=I
0977                 ISIG(NCHN,2)=J
0978                 ISIG(NCHN,3)=2
0979                 IF(ITCM(5).LE.0.OR.(ITCM(5).EQ.1.AND.IA.GE.3)) THEN
0980                   SIGH(NCHN-1)=0.5D0*FACQQ1*RATQQI
0981                   SIGH(NCHN)=0.5D0*FACQQ2*RATQQI
0982                 ELSE
0983                   SIGH(NCHN-1)=0.5D0*FACCI1*RATCII
0984                   SIGH(NCHN)=0.5D0*FACCI2*RATCII
0985                 ENDIF
0986               ENDIF
0987   420       CONTINUE
0988   430     CONTINUE
0989
0990         ELSEIF(ISUB.EQ.382) THEN
0991 C...f + fbar -> f' + fbar' (q + qbar -> q' + qbar' only)
0992           CALL PYWIDT(21,SH,WDTP,WDTE)
0993           FACQQF=COMFAC*AS**2*4D0/9D0*(TH2+UH2)
0994           FACQQB=FACQQF*SQDQQS*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
0995           IF(ITCM(5).EQ.1) THEN
0996 C...Modifications from contact interactions (compositeness)
0997             FACCIB=FACQQB
0998             DO 440 I=1,2
0999               FACCIB=FACCIB+COMFAC*(UH2/RTCM(41)**4)*(WDTE(I,1)+
1000      &        WDTE(I,2)+WDTE(I,4))
1001   440       CONTINUE
1002           ELSEIF(ITCM(5).GE.2.AND.ITCM(5).LE.4) THEN
1003             FACCIB=FACQQB+COMFAC*(UH2/RTCM(41)**4)*
1004      &      (WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
1005           ELSEIF(ITCM(5).EQ.5) THEN
1006             FACQQB=FACQQF*SQDQQS*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)-
1007      &      WDTE(5,1)-WDTE(5,2)-WDTE(5,4))
1008             FACCIB=FACQQF*SQDQTS*(WDTE(5,1)+WDTE(5,2)+WDTE(5,4))
1009           ENDIF
1010           DO 450 I=MMINA,MMAXA
1011             IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
1012      &      KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 450
1013             NCHN=NCHN+1
1014             ISIG(NCHN,1)=I
1015             ISIG(NCHN,2)=-I
1016             ISIG(NCHN,3)=1
1017             IF(ITCM(5).LE.0.OR.(ITCM(5).EQ.1.AND.IABS(I).GE.3)) THEN
1018               SIGH(NCHN)=FACQQB
1019             ELSEIF(ITCM(5).EQ.5) THEN
1020               SIGH(NCHN)=FACQQB
1021               NCHN=NCHN+1
1022               ISIG(NCHN,1)=I
1023               ISIG(NCHN,2)=-I
1024               ISIG(NCHN,3)=2
1025               SIGH(NCHN)=FACCIB
1026             ELSE
1027               SIGH(NCHN)=FACCIB
1028             ENDIF
1029   450     CONTINUE
1030
1031         ELSEIF(ISUB.EQ.383) THEN
1032 C...f + fbar -> g + g (q + qbar -> g + g only)
1033           FACGG1=COMFAC*AS**2*32D0/27D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)*
1034      &    UH2/SH2+9D0/4D0*TH*UH/SH2*SQDLGS)
1035           FACGG2=COMFAC*AS**2*32D0/27D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)*
1036      &    TH2/SH2+9D0/4D0*TH*UH/SH2*SQDLGS)
1037           IF(ITCM(5).EQ.5) THEN
1038             FACGG3=COMFAC*AS**2*32D0/27D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)*
1039      &      UH2/SH2+9D0/4D0*TH*UH/SH2*SQDHGS)
1040             FACGG4=COMFAC*AS**2*32D0/27D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)*
1041      &      TH2/SH2+9D0/4D0*TH*UH/SH2*SQDHGS)
1042           ENDIF
1043           DO 460 I=MMINA,MMAXA
1044             IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
1045      &      KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 460
1046             NCHN=NCHN+1
1047             ISIG(NCHN,1)=I
1048             ISIG(NCHN,2)=-I
1049             ISIG(NCHN,3)=1
1050             SIGH(NCHN)=0.5D0*FACGG1
1051             IF(ITCM(5).EQ.5.AND.IABS(I).EQ.5) SIGH(NCHN)=0.5D0*FACGG3
1052             NCHN=NCHN+1
1053             ISIG(NCHN,1)=I
1054             ISIG(NCHN,2)=-I
1055             ISIG(NCHN,3)=2
1056             SIGH(NCHN)=0.5D0*FACGG2
1057             IF(ITCM(5).EQ.5.AND.IABS(I).EQ.5) SIGH(NCHN)=0.5D0*FACGG4
1058   460     CONTINUE
1059
1060         ELSEIF(ISUB.EQ.384) THEN
1061 C...f + g -> f + g (q + g -> q + g only)
1062           FACQG1=COMFAC*AS**2*4D0/9D0*((2D0+MSTP(34)*1D0/4D0)*UH2/TH2-
1063      &    UH/SH-9D0/4D0*SH*UH/TH2*SQDLGT)*FACA
1064           FACQG2=COMFAC*AS**2*4D0/9D0*((2D0+MSTP(34)*1D0/4D0)*SH2/TH2-
1065      &    SH/UH-9D0/4D0*SH*UH/TH2*SQDLGT)
1066           DO 480 I=MMINA,MMAXA
1067             IF(I.EQ.0.OR.IABS(I).GT.10) GOTO 480
1068             DO 470 ISDE=1,2
1069               IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 470
1070               IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 470
1071               NCHN=NCHN+1
1072               ISIG(NCHN,ISDE)=I
1073               ISIG(NCHN,3-ISDE)=21
1074               ISIG(NCHN,3)=1
1075               SIGH(NCHN)=FACQG1
1076               NCHN=NCHN+1
1077               ISIG(NCHN,ISDE)=I
1078               ISIG(NCHN,3-ISDE)=21
1079               ISIG(NCHN,3)=2
1080               SIGH(NCHN)=FACQG2
1081   470       CONTINUE
1082   480     CONTINUE
1083
1084         ELSEIF(ISUB.EQ.385) THEN
1085 C...g + g -> f + fbar (g + g -> q + qbar only)
1086           IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 500
1087           IDC0=MDCY(21,2)-1
1088 C...Begin by d, u, s flavours.
1089           FLAVWT=0D0
1090           IF(MDME(IDC0+1,1).GE.1) FLAVWT=FLAVWT+
1091      &    SQRT(MAX(0D0,1D0-4D0*PMAS(1,1)**2/SH))
1092           IF(MDME(IDC0+2,1).GE.1) FLAVWT=FLAVWT+
1093      &    SQRT(MAX(0D0,1D0-4D0*PMAS(2,1)**2/SH))
1094           IF(MDME(IDC0+3,1).GE.1) FLAVWT=FLAVWT+
1095      &    SQRT(MAX(0D0,1D0-4D0*PMAS(3,1)**2/SH))
1096           FACQQ1=COMFAC*AS**2*1D0/6D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)*
1097      &    UH2/SH2+9D0/4D0*TH*UH/SH2*SQDLGS)*FLAVWT*FACA
1098           FACQQ2=COMFAC*AS**2*1D0/6D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)*
1099      &    TH2/SH2+9D0/4D0*TH*UH/SH2*SQDLGS)*FLAVWT*FACA
1100           NCHN=NCHN+1
1101           ISIG(NCHN,1)=21
1102           ISIG(NCHN,2)=21
1103           ISIG(NCHN,3)=1
1104           SIGH(NCHN)=FACQQ1
1105           NCHN=NCHN+1
1106           ISIG(NCHN,1)=21
1107           ISIG(NCHN,2)=21
1108           ISIG(NCHN,3)=2
1109           SIGH(NCHN)=FACQQ2
1110 C...Next c and b flavours: modified that and uhat for fixed
1111 C...cos(theta-hat).
1112           DO 490 IFL=4,5
1113           SQMAVG=PMAS(IFL,1)**2
1114           IF(MDME(IDC0+IFL,1).GE.1.AND.SH.GT.4.04D0*SQMAVG) THEN
1115             BE34=SQRT(1D0-4D0*SQMAVG/SH)
1116             THQ=-0.5D0*SH*(1D0-BE34*CTH)
1117             UHQ=-0.5D0*SH*(1D0+BE34*CTH)
1118             THUHQ=THQ*UHQ-SQMAVG*SH
1119             IF(MSTP(34).EQ.0) THEN
1120               FACQQ1=UHQ/THQ-2D0*UHQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/THQ**2
1121               FACQQ2=THQ/UHQ-2D0*THQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/UHQ**2
1122             ELSE
1123               FACQQ1=UHQ/THQ-2.25D0*UHQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/
1124      &        THQ**2+0.5D0*SQMAVG*(THQ+SQMAVG)/THQ**2-SQMAVG**2/(SH*THQ)
1125               FACQQ2=THQ/UHQ-2.25D0*THQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/
1126      &        UHQ**2+0.5D0*SQMAVG*(UHQ+SQMAVG)/UHQ**2-SQMAVG**2/(SH*UHQ)
1127             ENDIF
1128             IF(ITCM(5).GE.5) THEN
1129               IF(IFL.EQ.4) THEN
1130                 FACQQ1=FACQQ1+2.25D0*SQMAVG*(THQ-UHQ)/(SH*THQ)*REDLGS+
1131      &          2.25D0*THQ*UHQ/SH2*SQDLGS
1132                 FACQQ2=FACQQ2+2.25D0*SQMAVG*(UHQ-THQ)/(SH*UHQ)*REDLGS+
1133      &          2.25D0*THQ*UHQ/SH2*SQDLGS
1134               ELSE
1135                 FACQQ1=FACQQ1+2.25D0*SQMAVG*(THQ-UHQ)/(SH*THQ)*REDHGS+
1136      &          2.25D0*THQ*UHQ/SH2*SQDHGS
1137                 FACQQ2=FACQQ2+2.25D0*SQMAVG*(UHQ-THQ)/(SH*UHQ)*REDHGS+
1138      &          2.25D0*THQ*UHQ/SH2*SQDHGS
1139               ENDIF
1140             ENDIF
1141             FACQQ1=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ1*BE34
1142             FACQQ2=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ2*BE34
1143             NCHN=NCHN+1
1144             ISIG(NCHN,1)=21
1145             ISIG(NCHN,2)=21
1146             ISIG(NCHN,3)=1+2*(IFL-3)
1147             SIGH(NCHN)=FACQQ1
1148             NCHN=NCHN+1
1149             ISIG(NCHN,1)=21
1150             ISIG(NCHN,2)=21
1151             ISIG(NCHN,3)=2+2*(IFL-3)
1152             SIGH(NCHN)=FACQQ2
1153           ENDIF
1154   490     CONTINUE
1155   500     CONTINUE
1156
1157         ELSEIF(ISUB.EQ.386) THEN
1158 C...g + g -> g + g
1159           IF(ITCM(5).LE.4) THEN
1160             FACGG1=COMFAC*AS**2*9D0/4D0*(SH2/TH2+2D0*SH/TH+3D0+
1161      &      2D0*TH/SH+TH2/SH2)*FACA
1162             FACGG2=COMFAC*AS**2*9D0/4D0*(UH2/SH2+2D0*UH/SH+3D0+
1163      &      2D0*SH/UH+SH2/UH2)*FACA
1164             FACGG3=COMFAC*AS**2*9D0/4D0*(TH2/UH2+2D0*TH/UH+3D0+
1165      &      2D0*UH/TH+UH2/TH2)
1166           ELSE
1167             GST=  (12D0 + 40D0*TH/SH + 56D0*TH2/SH2 + 32D0*TH**3/SH**3 +
1168      &      16D0*TH**4/SH**4 + SQDGGS*(4D0*SH2 + 16D0*SH*TH + 16D0*TH2)+
1169      &      4D0*REDGST*(SH + 2D0*TH)*
1170      &      (2D0*SH**3 - 3D0*SH2*TH - 2D0*SH*TH2 + 2D0*TH**3)/SH2 +
1171      &      2D0*REDGGS*(2D0*SH - 12D0*TH2/SH - 8D0*TH**3/SH2) +
1172      &      2D0*REDGGT*(4D0*SH - 22D0*TH - 68D0*TH2/SH - 60D0*TH**3/SH2-
1173      &      32D0*TH**4/SH**3 - 16D0*TH**5/SH**4) +
1174      &      SQDGGT*(16D0*SH2 + 16D0*SH*TH + 68D0*TH2 + 144D0*TH**3/SH +
1175      &      96D0*TH**4/SH2 + 32D0*TH**5/SH**3 + 16D0*TH**6/SH**4))/16D0
1176             GSU=  (12D0 + 40D0*UH/SH + 56D0*UH2/SH2 + 32D0*UH**3/SH**3 +
1177      &      16D0*UH**4/SH**4 + SQDGGS*(4D0*SH2 + 16D0*SH*UH + 16D0*UH2)+
1178      &      4D0*REDGSU*(SH + 2D0*UH)*
1179      &      (2D0*SH**3 - 3D0*SH2*UH - 2D0*SH*UH2 + 2D0*UH**3)/SH2 +
1180      &      2D0*REDGGS*(2D0*SH - 12D0*UH2/SH - 8D0*UH**3/SH2) +
1181      &      2D0*REDGGU*(4D0*SH - 22D0*UH - 68D0*UH2/SH - 60D0*UH**3/SH2-
1182      &      32D0*UH**4/SH**3 - 16D0*UH**5/SH**4) +
1183      &      SQDGGU*(16D0*SH2 + 16D0*SH*UH + 68D0*UH2 + 144D0*UH**3/SH +
1184      &      96D0*UH**4/SH2 + 32D0*UH**5/SH**3 + 16D0*UH**6/SH**4))/16D0
1185             GUT=  (12D0 - 16D0*TH*(TH - UH)**2*UH/SH**4 +
1186      &      4D0*REDGGU*(2D0*TH**5 - 15D0*TH**4*UH - 48D0*TH**3*UH2 -
1187      &      58D0*TH2*UH**3 - 10D0*TH*UH**4 + UH**5)/SH**4 +
1188      &      4D0*REDGGT*(TH**5 - 10D0*TH**4*UH - 58D0*TH**3*UH2 -
1189      &      48D0*TH2*UH**3 - 15D0*TH*UH**4 + 2D0*UH**5)/SH**4 +
1190      &      4D0*SQDGGU*(4D0*TH**6 + 20D0*TH**5*UH + 57D0*TH**4*UH2 +
1191      &      72D0*TH**3*UH**3+ 38D0*TH2*UH**4+4D0*TH*UH**5 +UH**6)/SH**4+
1192      &      4D0*SQDGGT*(4D0*UH**6 + 4D0*TH**5*UH + 38D0*TH**4*UH2 +
1193      &      72D0*TH**3*UH**3 +57D0*TH2*UH**4+20D0*TH*UH**5+TH**6)/SH**4+
1194      &      2D0*REDGTU*((TH - UH)**2* (TH**4 + 20D0*TH**3*UH +
1195      &      30D0*TH2*UH2 + 20D0*TH*UH**3 + UH**4) +
1196      &      SH2*(7D0*TH**4 + 52D0*TH**3*UH + 274D0*TH2*UH2 +
1197      &      52D0*TH*UH**3 + 7D0*UH**4))/(2D0*SH**4))/16D0
1198             FACGG1=COMFAC*AS**2*9D0/4D0*GST*FACA
1199             FACGG2=COMFAC*AS**2*9D0/4D0*GSU*FACA
1200             FACGG3=COMFAC*AS**2*9D0/4D0*GUT
1201           ENDIF
1202           IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 510
1203           NCHN=NCHN+1
1204           ISIG(NCHN,1)=21
1205           ISIG(NCHN,2)=21
1206           ISIG(NCHN,3)=1
1207           SIGH(NCHN)=0.5D0*FACGG1
1208           NCHN=NCHN+1
1209           ISIG(NCHN,1)=21
1210           ISIG(NCHN,2)=21
1211           ISIG(NCHN,3)=2
1212           SIGH(NCHN)=0.5D0*FACGG2
1213           NCHN=NCHN+1
1214           ISIG(NCHN,1)=21
1215           ISIG(NCHN,2)=21
1216           ISIG(NCHN,3)=3
1217           SIGH(NCHN)=0.5D0*FACGG3
1218   510     CONTINUE
1219
1220         ELSEIF(ISUB.EQ.387) THEN
1221 C...q + qbar -> Q + Qbar
1222           SQMAVG=0.5D0*(SQM3+SQM4)-0.25D0*(SQM3-SQM4)**2/SH
1223           THQ=-0.5D0*SH*(1D0-BE34*CTH)
1224           UHQ=-0.5D0*SH*(1D0+BE34*CTH)
1225           FACQQB=COMFAC*AS**2*4D0/9D0*((THQ**2+UHQ**2)/SH2+
1226      &    2D0*SQMAVG/SH)
1227           IF(ITCM(5).GE.5) THEN
1228             IF(MINT(55).EQ.5.OR.MINT(55).EQ.6) THEN
1229               FACQQB=FACQQB*SH2*SQDQTS
1230             ELSE
1231               FACQQB=FACQQB*SH2*SQDQQS
1232             ENDIF
1233           ENDIF
1234           IF(MSTP(35).GE.1) FACQQB=FACQQB*PYHFTH(SH,SQMAVG,0D0)
1235           WID2=1D0
1236           IF(MINT(55).EQ.6) WID2=WIDS(6,1)
1237           IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=WIDS(MINT(55),1)
1238           FACQQB=FACQQB*WID2
1239           DO 520 I=MMINA,MMAXA
1240             IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
1241      &      KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 520
1242             NCHN=NCHN+1
1243             ISIG(NCHN,1)=I
1244             ISIG(NCHN,2)=-I
1245             ISIG(NCHN,3)=1
1246             SIGH(NCHN)=FACQQB
1247   520     CONTINUE
1248
1249         ELSEIF(ISUB.EQ.388) THEN
1250 C...g + g -> Q + Qbar
1251           SQMAVG=0.5D0*(SQM3+SQM4)-0.25D0*(SQM3-SQM4)**2/SH
1252           THQ=-0.5D0*SH*(1D0-BE34*CTH)
1253           UHQ=-0.5D0*SH*(1D0+BE34*CTH)
1254           THUHQ=THQ*UHQ-SQMAVG*SH
1255           IF(MSTP(34).EQ.0) THEN
1256             FACQQ1=UHQ/THQ-2D0*UHQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/THQ**2
1257             FACQQ2=THQ/UHQ-2D0*THQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/UHQ**2
1258           ELSE
1259             FACQQ1=UHQ/THQ-2.25D0*UHQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/
1260      &      THQ**2+0.5D0*SQMAVG*(THQ+SQMAVG)/THQ**2-SQMAVG**2/(SH*THQ)
1261             FACQQ2=THQ/UHQ-2.25D0*THQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/
1262      &      UHQ**2+0.5D0*SQMAVG*(UHQ+SQMAVG)/UHQ**2-SQMAVG**2/(SH*UHQ)
1263           ENDIF
1264           IF(ITCM(5).GE.5) THEN
1265             IF(MINT(55).EQ.5.OR.MINT(55).EQ.6) THEN
1266               FACQQ1=FACQQ1+2.25D0*SQMAVG*(THQ-UHQ)/(SH*THQ)*REDHGS+
1267      &        2.25D0*THQ*UHQ/SH2*SQDHGS
1268               FACQQ2=FACQQ2+2.25D0*SQMAVG*(UHQ-THQ)/(SH*UHQ)*REDHGS+
1269      &        2.25D0*THQ*UHQ/SH2*SQDHGS
1270             ELSE
1271               FACQQ1=FACQQ1+2.25D0*SQMAVG*(THQ-UHQ)/(SH*THQ)*REDLGS+
1272      &        2.25D0*THQ*UHQ/SH2*SQDLGS
1273               FACQQ2=FACQQ2+2.25D0*SQMAVG*(UHQ-THQ)/(SH*UHQ)*REDLGS+
1274      &        2.25D0*THQ*UHQ/SH2*SQDLGS
1275             ENDIF
1276           ENDIF
1277           FACQQ1=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ1
1278           FACQQ2=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ2
1279           IF(MSTP(35).GE.1) THEN
1280             FATRE=PYHFTH(SH,SQMAVG,2D0/7D0)
1281             FACQQ1=FACQQ1*FATRE
1282             FACQQ2=FACQQ2*FATRE
1283           ENDIF
1284           WID2=1D0
1285           IF(MINT(55).EQ.6) WID2=WIDS(6,1)
1286           IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=WIDS(MINT(55),1)
1287           FACQQ1=FACQQ1*WID2
1288           FACQQ2=FACQQ2*WID2
1289           IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 530
1290           NCHN=NCHN+1
1291           ISIG(NCHN,1)=21
1292           ISIG(NCHN,2)=21
1293           ISIG(NCHN,3)=1
1294           SIGH(NCHN)=FACQQ1
1295           NCHN=NCHN+1
1296           ISIG(NCHN,1)=21
1297           ISIG(NCHN,2)=21
1298           ISIG(NCHN,3)=2
1299           SIGH(NCHN)=FACQQ2
1300   530     CONTINUE
1301         ENDIF
1302       ENDIF
1303
1304 CMRENNA--
1305
1306       RETURN
1307       END