pythiaeRHIC/pythia/pysghf.f

0001
0002 C*********************************************************************
0003
0004 C...PYSGHF
0005 C...Subprocess cross sections for heavy flavour production,
0006 C...open and closed.
0007 C...Auxiliary to PYSIGH.
0008
0009       SUBROUTINE PYSGHF(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/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/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA,
0027      &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4,
0028      &SHR,SQPTH,TAUP,BE34,CTH,X(2),SQMZ,SQMW,GMMZ,GMMW,
0029      &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR
0030       SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/,
0031      &/PYINT4/,/PYSGCM/
0032 C...Local arrays
0033       DIMENSION WDTP(0:400),WDTE(0:400,0:5)
0034
0035 C...Determine where are charmonium/bottomonium wave function parameters.
0036       IONIUM=140
0037       IF(ISUB.GE.461.AND.ISUB.LE.479) IONIUM=145
0038
0039 C...Convert bottomonium process into equivalent charmonium ones.
0040       IF(ISUB.GE.461.AND.ISUB.LE.479) ISUB=ISUB-40
0041
0042 C...Differential cross section expressions.
0043
0044       IF(ISUB.LE.100) THEN
0045         IF(ISUB.EQ.81) THEN
0046 C...q + qbar -> Q + Qbar
0047           SQMAVG=0.5D0*(SQM3+SQM4)-0.25D0*(SQM3-SQM4)**2/SH
0048           THQ=-0.5D0*SH*(1D0-BE34*CTH)
0049           UHQ=-0.5D0*SH*(1D0+BE34*CTH)
0050           FACQQB=COMFAC*AS**2*4D0/9D0*((THQ**2+UHQ**2)/SH2+
0051      &    2D0*SQMAVG/SH)
0052           IF(MSTP(35).GE.1) FACQQB=FACQQB*PYHFTH(SH,SQMAVG,0D0)
0053           WID2=1D0
0054           IF(MINT(55).EQ.6) WID2=WIDS(6,1)
0055           IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=WIDS(MINT(55),1)
0056           FACQQB=FACQQB*WID2
0057           DO 100 I=MMINA,MMAXA
0058             IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
0059      &      KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 100
0060             NCHN=NCHN+1
0061             ISIG(NCHN,1)=I
0062             ISIG(NCHN,2)=-I
0063             ISIG(NCHN,3)=1
0064             SIGH(NCHN)=FACQQB
0065   100     CONTINUE
0066
0067         ELSEIF(ISUB.EQ.82) THEN
0068 C...g + g -> Q + Qbar
0069           SQMAVG=0.5D0*(SQM3+SQM4)-0.25D0*(SQM3-SQM4)**2/SH
0070           THQ=-0.5D0*SH*(1D0-BE34*CTH)
0071           UHQ=-0.5D0*SH*(1D0+BE34*CTH)
0072           THUHQ=THQ*UHQ-SQMAVG*SH
0073           IF(MSTP(34).EQ.0) THEN
0074             FACQQ1=UHQ/THQ-2D0*UHQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/THQ**2
0075             FACQQ2=THQ/UHQ-2D0*THQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/UHQ**2
0076           ELSE
0077             FACQQ1=UHQ/THQ-2.25D0*UHQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/
0078      &      THQ**2+0.5D0*SQMAVG*(THQ+SQMAVG)/THQ**2-SQMAVG**2/(SH*THQ)
0079             FACQQ2=THQ/UHQ-2.25D0*THQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/
0080      &      UHQ**2+0.5D0*SQMAVG*(UHQ+SQMAVG)/UHQ**2-SQMAVG**2/(SH*UHQ)
0081           ENDIF
0082           FACQQ1=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ1
0083           FACQQ2=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ2
0084           IF(MSTP(35).GE.1) THEN
0085             FATRE=PYHFTH(SH,SQMAVG,2D0/7D0)
0086             FACQQ1=FACQQ1*FATRE
0087             FACQQ2=FACQQ2*FATRE
0088           ENDIF
0089           WID2=1D0
0090           IF(MINT(55).EQ.6) WID2=WIDS(6,1)
0091           IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=WIDS(MINT(55),1)
0092           FACQQ1=FACQQ1*WID2
0093           FACQQ2=FACQQ2*WID2
0094           IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 110
0095           NCHN=NCHN+1
0096           ISIG(NCHN,1)=21
0097           ISIG(NCHN,2)=21
0098           ISIG(NCHN,3)=1
0099           SIGH(NCHN)=FACQQ1
0100           NCHN=NCHN+1
0101           ISIG(NCHN,1)=21
0102           ISIG(NCHN,2)=21
0103           ISIG(NCHN,3)=2
0104           SIGH(NCHN)=FACQQ2
0105   110     CONTINUE
0106
0107         ELSEIF(ISUB.EQ.83) THEN
0108 C...f + q -> f' + Q
0109           FACQQS=COMFAC*(0.5D0*AEM/XW)**2*SH*(SH-SQM3)/(SQMW-TH)**2
0110           FACQQU=COMFAC*(0.5D0*AEM/XW)**2*UH*(UH-SQM3)/(SQMW-TH)**2
0111           DO 130 I=MMIN1,MMAX1
0112             IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 130
0113             DO 120 J=MMIN2,MMAX2
0114               IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 120
0115               IF(I*J.GT.0.AND.MOD(IABS(I+J),2).EQ.0) GOTO 120
0116               IF(I*J.LT.0.AND.MOD(IABS(I+J),2).EQ.1) GOTO 120
0117               IF(IABS(I).LT.MINT(55).AND.MOD(IABS(I+MINT(55)),2).EQ.1)
0118      &        THEN
0119                 NCHN=NCHN+1
0120                 ISIG(NCHN,1)=I
0121                 ISIG(NCHN,2)=J
0122                 ISIG(NCHN,3)=1
0123                 IF(MOD(MINT(55),2).EQ.0) FACCKM=VCKM(MINT(55)/2,
0124      &          (IABS(I)+1)/2)*VINT(180+J)
0125                 IF(MOD(MINT(55),2).EQ.1) FACCKM=VCKM(IABS(I)/2,
0126      &          (MINT(55)+1)/2)*VINT(180+J)
0127                 WID2=1D0
0128                 IF(I.GT.0) THEN
0129                   IF(MINT(55).EQ.6) WID2=WIDS(6,2)
0130                   IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=
0131      &            WIDS(MINT(55),2)
0132                 ELSE
0133                   IF(MINT(55).EQ.6) WID2=WIDS(6,3)
0134                   IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=
0135      &            WIDS(MINT(55),3)
0136                 ENDIF
0137                 IF(I*J.GT.0) SIGH(NCHN)=FACQQS*FACCKM*WID2
0138                 IF(I*J.LT.0) SIGH(NCHN)=FACQQU*FACCKM*WID2
0139               ENDIF
0140               IF(IABS(J).LT.MINT(55).AND.MOD(IABS(J+MINT(55)),2).EQ.1)
0141      &        THEN
0142                 NCHN=NCHN+1
0143                 ISIG(NCHN,1)=I
0144                 ISIG(NCHN,2)=J
0145                 ISIG(NCHN,3)=2
0146                 IF(MOD(MINT(55),2).EQ.0) FACCKM=VCKM(MINT(55)/2,
0147      &          (IABS(J)+1)/2)*VINT(180+I)
0148                 IF(MOD(MINT(55),2).EQ.1) FACCKM=VCKM(IABS(J)/2,
0149      &          (MINT(55)+1)/2)*VINT(180+I)
0150                 IF(J.GT.0) THEN
0151                   IF(MINT(55).EQ.6) WID2=WIDS(6,2)
0152                   IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=
0153      &            WIDS(MINT(55),2)
0154                 ELSE
0155                   IF(MINT(55).EQ.6) WID2=WIDS(6,3)
0156                   IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=
0157      &            WIDS(MINT(55),3)
0158                 ENDIF
0159                 IF(I*J.GT.0) SIGH(NCHN)=FACQQS*FACCKM*WID2
0160                 IF(I*J.LT.0) SIGH(NCHN)=FACQQU*FACCKM*WID2
0161               ENDIF
0162   120       CONTINUE
0163   130     CONTINUE
0164
0165         ELSEIF(ISUB.EQ.84) THEN
0166 C...g + gamma -> Q + Qbar
0167           SQMAVG=0.5D0*(SQM3+SQM4)-0.25D0*(SQM3-SQM4)**2/SH
0168           THQ=-0.5D0*SH*(1D0-BE34*CTH)
0169           UHQ=-0.5D0*SH*(1D0+BE34*CTH)
0170           FACQQ=COMFAC*AS*AEM*(KCHG(IABS(MINT(55)),1)/3D0)**2*
0171      &    (THQ**2+UHQ**2+4D0*SQMAVG*SH*(1D0-SQMAVG*SH/(THQ*UHQ)))/
0172      &    (THQ*UHQ)
0173           IF(MSTP(35).GE.1) FACQQ=FACQQ*PYHFTH(SH,SQMAVG,0D0)
0174           WID2=1D0
0175           IF(MINT(55).EQ.6) WID2=WIDS(6,1)
0176           IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=WIDS(MINT(55),1)
0177           FACQQ=FACQQ*WID2
0178           IF(KFAC(1,21)*KFAC(2,22).NE.0) THEN
0179             NCHN=NCHN+1
0180             ISIG(NCHN,1)=21
0181             ISIG(NCHN,2)=22
0182             ISIG(NCHN,3)=1
0183             SIGH(NCHN)=FACQQ
0184           ENDIF
0185           IF(KFAC(1,22)*KFAC(2,21).NE.0) THEN
0186             NCHN=NCHN+1
0187             ISIG(NCHN,1)=22
0188             ISIG(NCHN,2)=21
0189             ISIG(NCHN,3)=1
0190             SIGH(NCHN)=FACQQ
0191           ENDIF
0192
0193         ELSEIF(ISUB.EQ.85) THEN
0194 C...gamma + gamma -> F + Fbar (heavy fermion, quark or lepton)
0195           SQMAVG=0.5D0*(SQM3+SQM4)-0.25D0*(SQM3-SQM4)**2/SH
0196           THQ=-0.5D0*SH*(1D0-BE34*CTH)
0197           UHQ=-0.5D0*SH*(1D0+BE34*CTH)
0198           FACFF=COMFAC*AEM**2*(KCHG(IABS(MINT(56)),1)/3D0)**4*2D0*
0199      &    ((1D0-PARJ(131)*PARJ(132))*(THQ*UHQ-SQMAVG*SH)*
0200      &    (UHQ**2+THQ**2+2D0*SQMAVG*SH)+(1D0+PARJ(131)*PARJ(132))*
0201      &    SQMAVG*SH**2*(SH-2D0*SQMAVG))/(THQ*UHQ)**2
0202           IF(IABS(MINT(56)).LT.10) FACFF=3D0*FACFF
0203           IF(IABS(MINT(56)).LT.10.AND.MSTP(35).GE.1)
0204      &    FACFF=FACFF*PYHFTH(SH,SQMAVG,1D0)
0205           WID2=1D0
0206           IF(MINT(56).EQ.6) WID2=WIDS(6,1)
0207           IF(MINT(56).EQ.7.OR.MINT(56).EQ.8) WID2=WIDS(MINT(56),1)
0208           IF(MINT(56).EQ.17) WID2=WIDS(17,1)
0209           FACFF=FACFF*WID2
0210           IF(KFAC(1,22)*KFAC(2,22).NE.0) THEN
0211             NCHN=NCHN+1
0212             ISIG(NCHN,1)=22
0213             ISIG(NCHN,2)=22
0214             ISIG(NCHN,3)=1
0215             SIGH(NCHN)=FACFF
0216           ENDIF
0217
0218         ELSEIF(ISUB.EQ.86) THEN
0219 C...g + g -> J/Psi + g
0220           FACQQG=COMFAC*AS**3*(5D0/9D0)*PARP(38)*SQRT(SQM3)*
0221      &    (((SH*(SH-SQM3))**2+(TH*(TH-SQM3))**2+(UH*(UH-SQM3))**2)/
0222      &    ((TH-SQM3)*(UH-SQM3))**2)/(SH-SQM3)**2
0223           IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN
0224             NCHN=NCHN+1
0225             ISIG(NCHN,1)=21
0226             ISIG(NCHN,2)=21
0227             ISIG(NCHN,3)=1
0228             SIGH(NCHN)=FACQQG
0229           ENDIF
0230
0231         ELSEIF(ISUB.EQ.87) THEN
0232 C...g + g -> chi_0c + g
0233           PGTW=(SH*TH+TH*UH+UH*SH)/SH2
0234           QGTW=(SH*TH*UH)/SH**3
0235           RGTW=SQM3/SH
0236           FACQQG=COMFAC*AS**3*4D0*(PARP(39)/SQRT(SQM3))*(1D0/SH)*
0237      &    (9D0*RGTW**2*PGTW**4*(RGTW**4-2D0*RGTW**2*PGTW+PGTW**2)-
0238      &    6D0*RGTW*PGTW**3*QGTW*(2D0*RGTW**4-5D0*RGTW**2*PGTW+PGTW**2)-
0239      &    PGTW**2*QGTW**2*(RGTW**4+2D0*RGTW**2*PGTW-PGTW**2)+
0240      &    2D0*RGTW*PGTW*QGTW**3*(RGTW**2-PGTW)+6D0*RGTW**2*QGTW**4)/
0241      &    (QGTW*(QGTW-RGTW*PGTW)**4)
0242           IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN
0243             NCHN=NCHN+1
0244             ISIG(NCHN,1)=21
0245             ISIG(NCHN,2)=21
0246             ISIG(NCHN,3)=1
0247             SIGH(NCHN)=FACQQG
0248           ENDIF
0249
0250         ELSEIF(ISUB.EQ.88) THEN
0251 C...g + g -> chi_1c + g
0252           PGTW=(SH*TH+TH*UH+UH*SH)/SH2
0253           QGTW=(SH*TH*UH)/SH**3
0254           RGTW=SQM3/SH
0255           FACQQG=COMFAC*AS**3*12D0*(PARP(39)/SQRT(SQM3))*(1D0/SH)*
0256      &    PGTW**2*(RGTW*PGTW**2*(RGTW**2-4D0*PGTW)+2D0*QGTW*(-RGTW**4+
0257      &    5D0*RGTW**2*PGTW+PGTW**2)-15D0*RGTW*QGTW**2)/
0258      &    (QGTW-RGTW*PGTW)**4
0259           IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN
0260             NCHN=NCHN+1
0261             ISIG(NCHN,1)=21
0262             ISIG(NCHN,2)=21
0263             ISIG(NCHN,3)=1
0264             SIGH(NCHN)=FACQQG
0265           ENDIF
0266
0267         ELSEIF(ISUB.EQ.89) THEN
0268 C...g + g -> chi_2c + g
0269           PGTW=(SH*TH+TH*UH+UH*SH)/SH2
0270           QGTW=(SH*TH*UH)/SH**3
0271           RGTW=SQM3/SH
0272           FACQQG=COMFAC*AS**3*4D0*(PARP(39)/SQRT(SQM3))*(1D0/SH)*
0273      &    (12D0*RGTW**2*PGTW**4*(RGTW**4-2D0*RGTW**2*PGTW+PGTW**2)-
0274      &    3D0*RGTW*PGTW**3*QGTW*(8D0*RGTW**4-RGTW**2*PGTW+4D0*PGTW**2)+
0275      &    2D0*PGTW**2*QGTW**2*(-7D0*RGTW**4+43D0*RGTW**2*PGTW+PGTW**2)+
0276      &    RGTW*PGTW*QGTW**3*(16D0*RGTW**2-61D0*PGTW)+12D0*RGTW**2*
0277      &    QGTW**4)/(QGTW*(QGTW-RGTW*PGTW)**4)
0278           IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN
0279             NCHN=NCHN+1
0280             ISIG(NCHN,1)=21
0281             ISIG(NCHN,2)=21
0282             ISIG(NCHN,3)=1
0283             SIGH(NCHN)=FACQQG
0284           ENDIF
0285         ENDIF
0286
0287       ELSEIF(ISUB.LE.200) THEN
0288         IF(ISUB.EQ.104) THEN
0289 C...g + g -> chi_c0.
0290           KC=PYCOMP(10441)
0291           FACBW=COMFAC*12D0*AS**2*PARP(39)*PMAS(KC,2)/
0292      &    ((SH-PMAS(KC,1)**2)**2+(PMAS(KC,1)*PMAS(KC,2))**2)
0293           IF(ABS(SQRT(SH)-PMAS(KC,1)).GT.50D0*PMAS(KC,2)) FACBW=0D0
0294           IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN
0295             NCHN=NCHN+1
0296             ISIG(NCHN,1)=21
0297             ISIG(NCHN,2)=21
0298             ISIG(NCHN,3)=1
0299             SIGH(NCHN)=FACBW
0300           ENDIF
0301
0302         ELSEIF(ISUB.EQ.105) THEN
0303 C...g + g -> chi_c2.
0304           KC=PYCOMP(445)
0305           FACBW=COMFAC*16D0*AS**2*PARP(39)*PMAS(KC,2)/
0306      &    ((SH-PMAS(KC,1)**2)**2+(PMAS(KC,1)*PMAS(KC,2))**2)
0307           IF(ABS(SQRT(SH)-PMAS(KC,1)).GT.50D0*PMAS(KC,2)) FACBW=0D0
0308           IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN
0309             NCHN=NCHN+1
0310             ISIG(NCHN,1)=21
0311             ISIG(NCHN,2)=21
0312             ISIG(NCHN,3)=1
0313             SIGH(NCHN)=FACBW
0314           ENDIF
0315
0316         ELSEIF(ISUB.EQ.106) THEN
0317 C...g + g -> J/Psi + gamma.
0318           EQ=KCHG(MOD(KFPR(ISUB,1)/10,10),1)/3D0
0319           FACQQG=COMFAC*AEM*EQ**2*AS**2*(4D0/3D0)*PARP(38)*SQRT(SQM3)*
0320      &    (((SH*(SH-SQM3))**2+(TH*(TH-SQM3))**2+(UH*(UH-SQM3))**2)/
0321      &    ((TH-SQM3)*(UH-SQM3))**2)/(SH-SQM3)**2
0322           IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN
0323             NCHN=NCHN+1
0324             ISIG(NCHN,1)=21
0325             ISIG(NCHN,2)=21
0326             ISIG(NCHN,3)=1
0327             SIGH(NCHN)=FACQQG
0328           ENDIF
0329
0330         ELSEIF(ISUB.EQ.107) THEN
0331 C...g + gamma -> J/Psi + g.
0332           EQ=KCHG(MOD(KFPR(ISUB,1)/10,10),1)/3D0
0333           FACQQG=COMFAC*AEM*EQ**2*AS**2*(32D0/3D0)*PARP(38)*SQRT(SQM3)*
0334      &    (((SH*(SH-SQM3))**2+(TH*(TH-SQM3))**2+(UH*(UH-SQM3))**2)/
0335      &    ((TH-SQM3)*(UH-SQM3))**2)/(SH-SQM3)**2
0336           IF(KFAC(1,21)*KFAC(2,22).NE.0) THEN
0337             NCHN=NCHN+1
0338             ISIG(NCHN,1)=21
0339             ISIG(NCHN,2)=22
0340             ISIG(NCHN,3)=1
0341             SIGH(NCHN)=FACQQG
0342           ENDIF
0343           IF(KFAC(1,22)*KFAC(2,21).NE.0) THEN
0344             NCHN=NCHN+1
0345             ISIG(NCHN,1)=22
0346             ISIG(NCHN,2)=21
0347             ISIG(NCHN,3)=1
0348             SIGH(NCHN)=FACQQG
0349           ENDIF
0350
0351         ELSEIF(ISUB.EQ.108) THEN
0352 C...gamma + gamma -> J/Psi + gamma.
0353           EQ=KCHG(MOD(KFPR(ISUB,1)/10,10),1)/3D0
0354           FACQQG=COMFAC*AEM**3*EQ**6*384D0*PARP(38)*SQRT(SQM3)*
0355      &    (((SH*(SH-SQM3))**2+(TH*(TH-SQM3))**2+(UH*(UH-SQM3))**2)/
0356      &    ((TH-SQM3)*(UH-SQM3))**2)/(SH-SQM3)**2
0357           IF(KFAC(1,22)*KFAC(2,22).NE.0) THEN
0358             NCHN=NCHN+1
0359             ISIG(NCHN,1)=22
0360             ISIG(NCHN,2)=22
0361             ISIG(NCHN,3)=1
0362             SIGH(NCHN)=FACQQG
0363           ENDIF
0364         ENDIF
0365
0366 C...QUARKONIA+++
0367 C...Additional code by Stefan Wolf
0368       ELSE
0369
0370 C...Common code for quarkonium production.
0371         SHTH=SH+TH
0372         THUH=TH+UH
0373         UHSH=UH+SH
0374         SHTH2=SHTH**2
0375         THUH2=THUH**2
0376         UHSH2=UHSH**2
0377         IF ( (ISUB.GE.421.AND.ISUB.LE.424).OR.
0378      &       (ISUB.GE.431.AND.ISUB.LE.433)) THEN
0379           SQMQQ=SQM3
0380         ELSEIF((ISUB.GE.425.AND.ISUB.LE.430).OR.
0381      &         (ISUB.GE.434.AND.ISUB.LE.439)) THEN
0382           SQMQQ=SQM4
0383         ENDIF
0384         SQMQQR=SQRT(SQMQQ)
0385         IF(MSTP(145).EQ.1) THEN
0386            IF ( (ISUB.GE.421.AND.ISUB.LE.427).OR.
0387      &          (ISUB.GE.431.AND.ISUB.LE.436)) THEN
0388               AQ=UHSH/(2D0*X(1)) + SHTH/(2D0*X(2))
0389               BQ=UHSH/(2D0*X(1)) - SHTH/(2D0*X(2))
0390               ATILK1=X(1)*VINT(2)/2D0-UHSH/(2D0*SQMQQ)*AQ
0391               ATILK2=X(2)*VINT(2)/2D0-SHTH/(2D0*SQMQQ)*AQ
0392               BTILK1=-X(1)*VINT(2)/2D0-UHSH/(2D0*SQMQQ)*BQ
0393               BTILK2=X(2)*VINT(2)/2D0-SHTH/(2D0*SQMQQ)*BQ
0394            ELSEIF( (ISUB.GE.428.AND.ISUB.LE.430).OR.
0395      &             ISUB.GE.437) THEN
0396               AQ=SHTH/(2D0*X(1)) + UHSH/(2D0*X(2))
0397               BQ=SHTH/(2D0*X(1)) - UHSH/(2D0*X(2))
0398               ATILK1=X(1)*VINT(2)/2D0-SHTH/(2D0*SQMQQ)*AQ
0399               ATILK2=X(2)*VINT(2)/2D0-UHSH/(2D0*SQMQQ)*AQ
0400               BTILK1=-X(1)*VINT(2)/2D0-SHTH/(2D0*SQMQQ)*BQ
0401               BTILK2=X(2)*VINT(2)/2D0-UHSH/(2D0*SQMQQ)*BQ
0402            ENDIF
0403            AQ2=AQ**2
0404            BQ2=BQ**2
0405            SMQQ2=SQMQQ*VINT(2)
0406 C...Polarisation frames
0407            IF(MSTP(146).EQ.1) THEN
0408 C...Recoil frame
0409               POLH1=SQRT(AQ2-SMQQ2)
0410               POLH2=SQRT(VINT(2)*(AQ2-BQ2-SMQQ2))
0411               AZ=-SQMQQR/POLH1
0412               BZ=0D0
0413               AX=AQ*BQ/(POLH1*POLH2)
0414               BX=-POLH1/POLH2
0415            ELSEIF(MSTP(146).EQ.2) THEN
0416 C...Gottfried Jackson frame
0417               POLH1=AQ+BQ
0418               POLH2=POLH1*SQRT(VINT(2)*(AQ2-BQ2-SMQQ2))
0419               AZ=SQMQQR/POLH1
0420               BZ=AZ
0421               AX=-(BQ2+AQ*BQ+SMQQ2)/POLH2
0422               BX=(AQ2+AQ*BQ-SMQQ2)/POLH2
0423            ELSEIF(MSTP(146).EQ.3) THEN
0424 C...Target frame
0425               POLH1=AQ-BQ
0426               POLH2=POLH1*SQRT(VINT(2)*(AQ2-BQ2-SMQQ2))
0427               AZ=-SQMQQR/POLH1
0428               BZ=-AZ
0429               AX=-(BQ2-AQ*BQ+SMQQ2)/POLH2
0430               BX=-(AQ2-AQ*BQ-SMQQ2)/POLH2
0431            ELSEIF(MSTP(146).EQ.4) THEN
0432 C...Collins Soper frame
0433               POLH1=AQ2-BQ2
0434               POLH2=SQRT(VINT(2)*POLH1)
0435               AZ=-BQ/POLH2
0436               BZ=AQ/POLH2
0437               AX=-SQMQQR*AQ/SQRT(POLH1*(POLH1-SMQQ2))
0438               BX=SQMQQR*BQ/SQRT(POLH1*(POLH1-SMQQ2))
0439            ENDIF
0440 C...Contract EL1(lam) EL2(lam') with K1 and K2 (initial parton momenta)
0441            EL1K10=AZ*ATILK1+BZ*BTILK1
0442            EL1K20=AZ*ATILK2+BZ*BTILK2
0443            EL2K10=EL1K10
0444            EL2K20=EL1K20
0445            EL1K11=1D0/SQRT(2D0)*(AX*ATILK1+BX*BTILK1)
0446            EL1K21=1D0/SQRT(2D0)*(AX*ATILK2+BX*BTILK2)
0447            EL2K11=EL1K11
0448            EL2K21=EL1K21
0449         ENDIF
0450
0451         IF(ISUB.EQ.421) THEN
0452 C...g + g -> QQ~[3S11] + g
0453           IF(MSTP(145).EQ.0) THEN
0454 *            FACQQG=COMFAC*PARU(1)*AS**3*(10D0/81D0)*SQMQQR*
0455 *     &            (SH2*THUH2+TH2*UHSH2+UH2*SHTH2)/(SHTH2*THUH2*UHSH2)
0456             FACQQG=COMFAC*PARU(1)*AS**3*(10D0/81D0)*SQMQQR*
0457      &            (SH2*THUH2+TH2*UHSH2+UH2*SHTH2)/SHTH2/THUH2/UHSH2
0458 *            FACQQG=COMFAC*PARU(1)*AS**3*(10D0/81D0)*SQMQQR*
0459 *     &           (SH2/(SHTH2*UHSH2)+TH2/(SHTH2*THUH2)+UH2/(THUH2*UHSH2))
0460           ELSE
0461             FF=-PARU(1)*AS**3*(10D0/81D0)*SQMQQR/THUH2/SHTH2/UHSH2
0462             AA=(SHTH2*UH2+UHSH2*TH2+THUH2*SH2)/2D0
0463             BB=2D0*(SH2+TH2)
0464             CC=2D0*(SH2+UH2)
0465             DD=2D0*SH2
0466             IF(MSTP(147).EQ.0) THEN
0467                FACQQG=-AA+SQMQQ*(BB*EL1K10*EL2K10+CC*EL1K20*EL2K20
0468      &              +DD*(EL1K10*EL2K20+EL1K20*EL2K10))
0469             ELSEIF(MSTP(147).EQ.1) THEN
0470                FACQQG=2D0*(-AA+SQMQQ*(BB*EL1K11*EL2K11+CC*EL1K21*EL2K21
0471      &              +DD*(EL1K11*EL2K21+EL1K21*EL2K11)))
0472             ELSEIF(MSTP(147).EQ.3) THEN
0473                FACQQG=-AA+SQMQQ*(BB*EL1K10*EL2K10+CC*EL1K20*EL2K20
0474      &              +DD*(EL1K10*EL2K20+EL1K20*EL2K10))
0475             ELSEIF(MSTP(147).EQ.4) THEN
0476                FACQQG=-AA+SQMQQ*(BB*EL1K11*EL2K11+CC*EL1K21*EL2K21
0477      &              +DD*(EL1K11*EL2K21+EL1K21*EL2K11))
0478             ELSEIF(MSTP(147).EQ.5) THEN
0479                FACQQG=SQMQQ*(BB*EL1K11*EL2K10+CC*EL1K21*EL2K20
0480      &              +DD*(EL1K11*EL2K20+EL1K21*EL2K10))
0481             ELSEIF(MSTP(147).EQ.6) THEN
0482                FACQQG=SQMQQ*(BB*EL1K11*EL2K11+CC*EL1K21*EL2K21
0483      &              +DD*(EL1K11*EL2K21+EL1K21*EL2K11))
0484             ENDIF
0485             FACQQG=COMFAC*FF*FACQQG
0486           ENDIF
0487           IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN
0488             NCHN=NCHN+1
0489             ISIG(NCHN,1)=21
0490             ISIG(NCHN,2)=21
0491             ISIG(NCHN,3)=1
0492             SIGH(NCHN)=FACQQG*PARP(IONIUM+1)
0493           ENDIF
0494
0495         ELSEIF(ISUB.EQ.422) THEN
0496 C...g + g -> QQ~[3S18] + g
0497           IF(MSTP(145).EQ.0) THEN
0498             FACQQG=-COMFAC*PARU(1)*AS**3*(1D0/72D0)*
0499      &            (16D0*SQMQQ**2-27D0*(SHTH2+THUH2+UHSH2))/
0500      &            (SQMQQ*SQMQQR)*
0501      &            ((SH2*THUH2+TH2*UHSH2+UH2*SHTH2)/SHTH2/THUH2/UHSH2)
0502           ELSE
0503             FF=PARU(1)*AS**3*(16D0*SQMQQ**2-27D0*(SHTH2+THUH2+UHSH2))/
0504      &            (72D0*SQMQQ*SQMQQR*SHTH2*THUH2*UHSH2)
0505             AA=(SHTH2*UH2+UHSH2*TH2+THUH2*SH2)/2D0
0506             BB=2D0*(SH2+TH2)
0507             CC=2D0*(SH2+UH2)
0508             DD=2D0*SH2
0509             IF(MSTP(147).EQ.0) THEN
0510                FACQQG=-AA+SQMQQ*(BB*EL1K10*EL2K10+CC*EL1K20*EL2K20
0511      &              +DD*(EL1K10*EL2K20+EL1K20*EL2K10))
0512             ELSEIF(MSTP(147).EQ.1) THEN
0513                FACQQG=2D0*(-AA+SQMQQ*(BB*EL1K11*EL2K11+CC*EL1K21*EL2K21
0514      &              +DD*(EL1K11*EL2K21+EL1K21*EL2K11)))
0515             ELSEIF(MSTP(147).EQ.3) THEN
0516                FACQQG=-AA+SQMQQ*(BB*EL1K10*EL2K10+CC*EL1K20*EL2K20
0517      &              +DD*(EL1K10*EL2K20+EL1K20*EL2K10))
0518             ELSEIF(MSTP(147).EQ.4) THEN
0519                FACQQG=-AA+SQMQQ*(BB*EL1K11*EL2K11+CC*EL1K21*EL2K21
0520      &              +DD*(EL1K11*EL2K21+EL1K21*EL2K11))
0521             ELSEIF(MSTP(147).EQ.5) THEN
0522                FACQQG=SQMQQ*(BB*EL1K11*EL2K10+CC*EL1K21*EL2K20
0523      &              +DD*(EL1K11*EL2K20+EL1K21*EL2K10))
0524             ELSEIF(MSTP(147).EQ.6) THEN
0525                FACQQG=SQMQQ*(BB*EL1K11*EL2K11+CC*EL1K21*EL2K21
0526      &              +DD*(EL1K11*EL2K21+EL1K21*EL2K11))
0527             ENDIF
0528             FACQQG=COMFAC*FF*FACQQG
0529           ENDIF
0530 C...Split total contribution into different colour flows just like
0531 C...in g g -> g g (recalculate kinematics for massless partons).
0532           THP=-0.5D0*SH*(1D0-CTH)
0533           UHP=-0.5D0*SH*(1D0+CTH)
0534           FACGG1=(SH/THP)**2+2D0*SH/THP+3D0+2D0*THP/SH+(THP/SH)**2
0535           FACGG2=(UHP/SH)**2+2D0*UHP/SH+3D0+2D0*SH/UHP+(SH/UHP)**2
0536           FACGG3=(THP/UHP)**2+2D0*THP/UHP+3D0+2D0*UHP/THP+(UHP/THP)**2
0537           FACGGS=FACGG1+FACGG2+FACGG3
0538           IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN
0539              NCHN=NCHN+1
0540              ISIG(NCHN,1)=21
0541              ISIG(NCHN,2)=21
0542              ISIG(NCHN,3)=1
0543              SIGH(NCHN)=FACQQG*PARP(IONIUM+2)*FACGG1/FACGGS
0544              NCHN=NCHN+1
0545              ISIG(NCHN,1)=21
0546              ISIG(NCHN,2)=21
0547              ISIG(NCHN,3)=2
0548              SIGH(NCHN)=FACQQG*PARP(IONIUM+2)*FACGG2/FACGGS
0549              NCHN=NCHN+1
0550              ISIG(NCHN,1)=21
0551              ISIG(NCHN,2)=21
0552              ISIG(NCHN,3)=3
0553              SIGH(NCHN)=FACQQG*PARP(IONIUM+2)*FACGG3/FACGGS
0554           ENDIF
0555
0556         ELSEIF(ISUB.EQ.423) THEN
0557 C...g + g -> QQ~[1S08] + g
0558           IF(MSTP(145).EQ.0) THEN
0559 *            FACQQG=COMFAC*PARU(1)*AS**3*(5D0/16D0)*
0560 *     &           (SHTH2*UH2+THUH2*SH2+UHSH2*TH2)/(SQMQQR*SH*TH*UH)*
0561 *     &           (12D0*SQMQQ*SH*TH*UH+SHTH2**2+THUH2**2+UHSH2**2)/
0562 *     &           (SHTH2*THUH2*UHSH2)
0563             FACQQG=COMFAC*PARU(1)*AS**3*(5D0/16D0)*SQMQQR*
0564      &            (UH2/(THUH2*UHSH2)+SH2/(SHTH2*UHSH2)+
0565      &            TH2/(SHTH2*THUH2))*
0566      &            (12D0+(SHTH2**2+THUH2**2+UHSH2**2)/(SQMQQ*SH*TH*UH))
0567           ELSE
0568             FA=PARU(1)*AS**3*(5D0/48D0)*SQMQQR*
0569      &            (UH2/(THUH2*UHSH2)+SH2/(SHTH2*UHSH2)+
0570      &            TH2/(SHTH2*THUH2))*
0571      &            (12D0+(SHTH2**2+THUH2**2+UHSH2**2)/(SQMQQ*SH*TH*UH))
0572             IF(MSTP(147).EQ.0) THEN
0573                FACQQG=COMFAC*FA
0574             ELSEIF(MSTP(147).EQ.1) THEN
0575                FACQQG=COMFAC*2D0*FA
0576             ELSEIF(MSTP(147).EQ.3) THEN
0577                FACQQG=COMFAC*FA
0578             ELSEIF(MSTP(147).EQ.4) THEN
0579                FACQQG=COMFAC*FA
0580             ELSEIF(MSTP(147).EQ.5) THEN
0581                FACQQG=0D0
0582             ELSEIF(MSTP(147).EQ.6) THEN
0583                FACQQG=0D0
0584             ENDIF
0585           ENDIF
0586 C...Split total contribution into different colour flows just like
0587 C...in g g -> g g (recalculate kinematics for massless partons).
0588           THP=-0.5D0*SH*(1D0-CTH)
0589           UHP=-0.5D0*SH*(1D0+CTH)
0590           FACGG1=(SH/THP)**2+2D0*SH/THP+3D0+2D0*THP/SH+(THP/SH)**2
0591           FACGG2=(UHP/SH)**2+2D0*UHP/SH+3D0+2D0*SH/UHP+(SH/UHP)**2
0592           FACGG3=(THP/UHP)**2+2D0*THP/UHP+3D0+2D0*UHP/THP+(UHP/THP)**2
0593           FACGGS=FACGG1+FACGG2+FACGG3
0594           IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN
0595              NCHN=NCHN+1
0596              ISIG(NCHN,1)=21
0597              ISIG(NCHN,2)=21
0598              ISIG(NCHN,3)=1
0599              SIGH(NCHN)=FACQQG*PARP(IONIUM+3)*FACGG1/FACGGS
0600              NCHN=NCHN+1
0601              ISIG(NCHN,1)=21
0602              ISIG(NCHN,2)=21
0603              ISIG(NCHN,3)=2
0604              SIGH(NCHN)=FACQQG*PARP(IONIUM+3)*FACGG2/FACGGS
0605              NCHN=NCHN+1
0606              ISIG(NCHN,1)=21
0607              ISIG(NCHN,2)=21
0608              ISIG(NCHN,3)=3
0609              SIGH(NCHN)=FACQQG*PARP(IONIUM+3)*FACGG3/FACGGS
0610           ENDIF
0611
0612         ELSEIF(ISUB.EQ.424) THEN
0613 C...g + g -> QQ~[3PJ8] + g
0614           POLY=SH2+SH*TH+TH2
0615           IF(MSTP(145).EQ.0) THEN
0616             FACQQG=COMFAC*5D0*PARU(1)*AS**3*(3D0*SH*TH*SHTH*POLY**4
0617      &            -SQMQQ*POLY**2*(7D0*SH**6+36D0*SH**5*TH+45D0*SH**4*TH2
0618      &            +28D0*SH**3*TH**3+45D0*SH2*TH**4+36D0*SH*TH**5
0619      &            +7D0*TH**6)
0620      &            +SQMQQ**2*SHTH*(35D0*SH**8+169D0*SH**7*TH
0621      &            +299D0*SH**6*TH2+401D0*SH**5*TH**3+418D0*SH**4*TH**4
0622      &            +401D0*SH**3*TH**5+299D0*SH2*TH**6+169D0*SH*TH**7
0623      &            +35D0*TH**8)
0624      &            -SQMQQ**3*(84D0*SH**8+432D0*SH**7*TH+905D0*SH**6*TH2
0625      &            +1287D0*SH**5*TH**3+1436D0*SH**4*TH**4
0626      &            +1287D0*SH**3*TH**5+905D0*SH2*TH**6+432D0*SH*TH**7
0627      &            +84D0*TH**8)
0628      &            +SQMQQ**4*SHTH*(126D0*SH**6+451D0*SH**5*TH
0629      &            +677D0*SH**4*TH2+836D0*SH**3*TH**3+677D0*SH2*TH**4
0630      &            +451D0*SH*TH**5+126D0*TH**6)
0631      &            -3D0*SQMQQ**5*(42D0*SH**6+171D0*SH**5*TH
0632      &            +304D0*SH**4*TH2+362D0*SH**3*TH**3+304D0*SH2*TH**4
0633      &            +171D0*SH*TH**5+42D0*TH**6)
0634      &            +2D0*SQMQQ**6*SHTH*(42D0*SH**4+106D0*SH**3*TH
0635      &            +119D0*SH2*TH2+106D0*SH*TH**3+42D0*TH**4)
0636      &            -SQMQQ**7*(35D0*SH**4+99D0*SH**3*TH+120D0*SH2*TH2
0637      &            +99D0*SH*TH**3+35D0*TH**4)
0638      &            +7D0*SQMQQ**8*SHTH*POLY)/
0639      &            (SH*TH*UH*SQMQQR*SQMQQ*
0640      &            SHTH*SHTH2*THUH*THUH2*UHSH*UHSH2)
0641           ELSE
0642             FF=-5D0*PARU(1)*AS**3/(SH2*TH2*UH2
0643      &            *SQMQQR*SQMQQ*SHTH*SHTH2*THUH*THUH2*UHSH*UHSH2)
0644             AA=SH*TH*UH*(SH*TH*SHTH*POLY**4
0645      &           -SQMQQ*SHTH2*POLY**2*
0646      &           (SH**4+6D0*SH**3*TH-6D0*SH2*TH2+6D0*SH*TH**3+TH**4)
0647      &           +SQMQQ**2*SHTH*(5D0*SH**8+35D0*SH**7*TH+49D0*SH**6*TH2
0648      &           +57D0*SH**5*TH**3+46D0*SH**4*TH**4+57D0*SH**3*TH**5
0649      &           +49D0*SH2*TH**6+35D0*SH*TH**7+5D0*TH**8)
0650      &           -SQMQQ**3*(16D0*SH**8+104D0*SH**7*TH+215D0*SH**6*TH2
0651      &           +291D0*SH**5*TH**3+316D0*SH**4*TH**4+291D0*SH**3*TH**5
0652      &           +215D0*SH2*TH**6+104D0*SH*TH**7+16D0*TH**8)
0653      &           +SQMQQ**4*SHTH*(34D0*SH**6+145D0*SH**5*TH
0654      &           +211D0*SH**4*TH2+262D0*SH**3*TH**3+211D0*SH2*TH**4
0655      &           +145D0*SH*TH**5+34D0*TH**6)
0656      &           -SQMQQ**5*(44D0*SH**6+193D0*SH**5*TH+346D0*SH**4*TH2
0657      &           +410D0*SH**3*TH**3+346D0*SH2*TH**4+193D0*SH*TH**5
0658      &           +44D0*TH**6)
0659      &           +2D0*SQMQQ**6*SHTH*(17D0*SH**4+45D0*SH**3*TH
0660      &           +49D0*SH2*TH2+45D0*SH*TH**3+17D0*TH**4)
0661      &           -SQMQQ**7*(3D0*SH2+2D0*SH*TH+3D0*TH2)
0662      &           *(5D0*SH2+11D0*SH*TH+5D0*TH2)
0663      &           +3D0*SQMQQ**8*SHTH*POLY)
0664             BB=4D0*SHTH2*POLY**3
0665      &           *(SH**4+SH**3*TH-SH2*TH2+SH*TH**3+TH**4)
0666      &           -SQMQQ*SHTH*(20D0*SH**10+84D0*SH**9*TH+166D0*SH**8*TH2
0667      &           +231D0*SH**7*TH**3+250D0*SH**6*TH**4+250D0*SH**5*TH**5
0668      &           +250D0*SH**4*TH**6+231D0*SH**3*TH**7+166D0*SH2*TH**8
0669      &           +84D0*SH*TH**9+20D0*TH**10)
0670      &           +SQMQQ**2*SHTH2*(40D0*SH**8+86D0*SH**7*TH
0671      &           +66D0*SH**6*TH2+67D0*SH**5*TH**3+6D0*SH**4*TH**4
0672      &           +67D0*SH**3*TH**5+66D0*SH2*TH**6+86D0*SH*TH**7
0673      &           +40D0*TH**8)
0674      &           -SQMQQ**3*SHTH*(40D0*SH**8+57D0*SH**7*TH
0675      &           -110D0*SH**6*TH2-263D0*SH**5*TH**3-384D0*SH**4*TH**4
0676      &           -263D0*SH**3*TH**5-110D0*SH2*TH**6+57D0*SH*TH**7
0677      &           +40D0*TH**8)
0678      &           +SQMQQ**4*(20D0*SH**8-33D0*SH**7*TH-368D0*SH**6*TH2
0679      &           -751D0*SH**5*TH**3-920D0*SH**4*TH**4-751D0*SH**3*TH**5
0680      &           -368D0*SH2*TH**6-33D0*SH*TH**7+20D0*TH**8)
0681      &           -SQMQQ**5*SHTH*(4D0*SH**6-81D0*SH**5*TH-242D0*SH**4*TH2
0682      &           -250D0*SH**3*TH**3-242D0*SH2*TH**4-81D0*SH*TH**5
0683      &           +4D0*TH**6)
0684      &           -SQMQQ**6*SH*TH*(41D0*SH**4+120D0*SH**3*TH
0685      &           +142D0*SH2*TH2+120D0*SH*TH**3+41D0*TH**4)
0686      &           +8D0*SQMQQ**7*SH*TH*SHTH*POLY
0687             CC=4D0*TH2*POLY**3
0688      &           *(-SH**4-2D0*SH**3*TH+2D0*SH2*TH2+3D0*SH*TH**3+TH**4)
0689      &           -SQMQQ*TH2*(-20D0*SH**9-56D0*SH**8*TH-24D0*SH**7*TH2
0690      &           +147D0*SH**6*TH**3+409D0*SH**5*TH**4+599D0*SH**4*TH**5
0691      &           +571D0*SH**3*TH**6+370D0*SH2*TH**7+148D0*SH*TH**8
0692      &           +28D0*TH**9)
0693      &           +SQMQQ**2*(4D0*SH**10+20D0*SH**9*TH-16D0*SH**8*TH2
0694      &           -48D0*SH**7*TH**3+150D0*SH**6*TH**4+611D0*SH**5*TH**5
0695      &           +1060D0*SH**4*TH**6+1155D0*SH**3*TH**7+854D0*SH2*TH**8
0696      &           +394D0*SH*TH**9+84D0*TH**10)
0697      &           -SQMQQ**3*SHTH*(20D0*SH**8+68D0*SH**7*TH-20D0*SH**6*TH2
0698      &           +32D0*SH**5*TH**3+286D0*SH**4*TH**4+577D0*SH**3*TH**5
0699      &           +618D0*SH2*TH**6+443D0*SH*TH**7+140D0*TH**8)
0700      &           +SQMQQ**4*(40D0*SH**8+152D0*SH**7*TH+94D0*SH**6*TH2
0701      &           +38D0*SH**5*TH**3+290D0*SH**4*TH**4+631D0*SH**3*TH**5
0702      &           +738D0*SH2*TH**6+513D0*SH*TH**7+140D0*TH**8)
0703      &           -SQMQQ**5*(40D0*SH**7+129D0*SH**6*TH+53D0*SH**5*TH2
0704      &           +7D0*SH**4*TH**3+129D0*SH**3*TH**4+264D0*SH2*TH**5
0705      &           +266D0*SH*TH**6+84D0*TH**7)
0706      &           +SQMQQ**6*(20D0*SH**6+55D0*SH**5*TH+2D0*SH**4*TH2
0707      &           -15D0*SH**3*TH**3+30D0*SH2*TH**4+76D0*SH*TH**5
0708      &           +28D0*TH**6)
0709      &           -SQMQQ**7*SHTH*(4D0*SH**4+7D0*SH**3*TH-14D0*SH2*TH2
0710      &           +7D0*SH*TH**3+4*TH**4)
0711      &           +SQMQQ**8*SH*(SH-TH)**2*TH
0712             DD=2D0*TH2*SHTH2*POLY**3
0713      &           *(-SH2+2*SH*TH+2*TH2)
0714      &           +SQMQQ*(4D0*SH**11+22D0*SH**10*TH+70D0*SH**9*TH2
0715      &           +115D0*SH**8*TH**3+71D0*SH**7*TH**4-119D0*SH**6*TH**5
0716      &           -381D0*SH**5*TH**6-552D0*SH**4*TH**7-512D0*SH**3*TH**8
0717      &           -320D0*SH2*TH**9-126D0*SH*TH**10-24D0*TH**11)
0718      &           -SQMQQ**2*SHTH*(20D0*SH**9+84D0*SH**8*TH
0719      &           +212D0*SH**7*TH2+247D0*SH**6*TH**3+105D0*SH**5*TH**4
0720      &           -178D0*SH**4*TH**5-380D0*SH**3*TH**6-364D0*SH2*TH**7
0721      &           -210D0*SH*TH**8-60D0*TH**9)
0722      &           +SQMQQ**3*SHTH*(40D0*SH**8+159D0*SH**7*TH
0723      &           +374D0*SH**6*TH2+404D0*SH**5*TH**3+192D0*SH**4*TH**4
0724      &           -141D0*SH**3*TH**5-264D0*SH2*TH**6-216D0*SH*TH**7
0725      &           -80D0*TH**8)
0726      &           -SQMQQ**4*(40D0*SH**8+197D0*SH**7*TH+506D0*SH**6*TH2
0727      &           +672D0*SH**5*TH**3+460D0*SH**4*TH**4+79D0*SH**3*TH**5
0728      &           -138D0*SH2*TH**6-164D0*SH*TH**7-60D0*TH**8)
0729      &           +SQMQQ**5*(20D0*SH**7+107D0*SH**6*TH+267D0*SH**5*TH2
0730      &           +307D0*SH**4*TH**3+185D0*SH**3*TH**4+56D0*SH2*TH**5
0731      &           -30D0*SH*TH**6-24D0*TH**7)
0732      &           -SQMQQ**6*(4D0*SH**6+31D0*SH**5*TH+74D0*SH**4*TH2
0733      &           +71D0*SH**3*TH**3+46D0*SH2*TH**4+10D0*SH*TH**5
0734      &           -4D0*TH**6)
0735      &           +4D0*SQMQQ**7*SH*TH*SHTH*POLY
0736             IF(MSTP(147).EQ.0) THEN
0737                FACQQG=-AA+SQMQQ*(BB*EL1K10*EL2K10+CC*EL1K20*EL2K20
0738      &              +DD*(EL1K10*EL2K20+EL1K20*EL2K10))
0739             ELSEIF(MSTP(147).EQ.1) THEN
0740                FACQQG=2D0*(-AA+SQMQQ*(BB*EL1K11*EL2K11+CC*EL1K21*EL2K21
0741      &              +DD*(EL1K11*EL2K21+EL1K21*EL2K11)))
0742             ELSEIF(MSTP(147).EQ.3) THEN
0743                FACQQG=-AA+SQMQQ*(BB*EL1K10*EL2K10+CC*EL1K20*EL2K20
0744      &              +DD*(EL1K10*EL2K20+EL1K20*EL2K10))
0745             ELSEIF(MSTP(147).EQ.4) THEN
0746                FACQQG=-AA+SQMQQ*(BB*EL1K11*EL2K11+CC*EL1K21*EL2K21
0747      &              +DD*(EL1K11*EL2K21+EL1K21*EL2K11))
0748             ELSEIF(MSTP(147).EQ.5) THEN
0749                FACQQG=SQMQQ*(BB*EL1K11*EL2K10+CC*EL1K21*EL2K20
0750      &              +DD*(EL1K11*EL2K20+EL1K21*EL2K10))
0751             ELSEIF(MSTP(147).EQ.6) THEN
0752                FACQQG=SQMQQ*(BB*EL1K11*EL2K11+CC*EL1K21*EL2K21
0753      &              +DD*(EL1K11*EL2K21+EL1K21*EL2K11))
0754             ENDIF
0755             FACQQG=COMFAC*FF*FACQQG
0756           ENDIF
0757 C...Split total contribution into different colour flows just like
0758 C...in g g -> g g (recalculate kinematics for massless partons).
0759           THP=-0.5D0*SH*(1D0-CTH)
0760           UHP=-0.5D0*SH*(1D0+CTH)
0761           FACGG1=(SH/THP)**2+2D0*SH/THP+3D0+2D0*THP/SH+(THP/SH)**2
0762           FACGG2=(UHP/SH)**2+2D0*UHP/SH+3D0+2D0*SH/UHP+(SH/UHP)**2
0763           FACGG3=(THP/UHP)**2+2D0*THP/UHP+3D0+2D0*UHP/THP+(UHP/THP)**2
0764           FACGGS=FACGG1+FACGG2+FACGG3
0765           IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN
0766              NCHN=NCHN+1
0767              ISIG(NCHN,1)=21
0768              ISIG(NCHN,2)=21
0769              ISIG(NCHN,3)=1
0770              SIGH(NCHN)=FACQQG*PARP(IONIUM+4)*FACGG1/FACGGS
0771              NCHN=NCHN+1
0772              ISIG(NCHN,1)=21
0773              ISIG(NCHN,2)=21
0774              ISIG(NCHN,3)=2
0775              SIGH(NCHN)=FACQQG*PARP(IONIUM+4)*FACGG2/FACGGS
0776              NCHN=NCHN+1
0777              ISIG(NCHN,1)=21
0778              ISIG(NCHN,2)=21
0779              ISIG(NCHN,3)=3
0780              SIGH(NCHN)=FACQQG*PARP(IONIUM+4)*FACGG3/FACGGS
0781           ENDIF
0782
0783         ELSEIF(ISUB.EQ.425) THEN
0784 C...q + g -> q + QQ~[3S18]
0785           IF(MSTP(145).EQ.0) THEN
0786             FACQQG=-COMFAC*PARU(1)*AS**3*(1D0/27D0)*
0787      &            (4D0*(SH2+UH2)-SH*UH)*(SHTH2+THUH2)/
0788      &            (SQMQQ*SQMQQR*SH*UH*UHSH2)
0789           ELSE
0790             FF=PARU(1)*AS**3*(4D0*(SH2+UH2)-SH*UH)/
0791      &            (54D0*SQMQQ*SQMQQR*SH*UH*UHSH2)
0792             AA=SHTH2+THUH2
0793             BB=4D0
0794             CC=8D0
0795             DD=4D0
0796             IF(MSTP(147).EQ.0) THEN
0797                FACQQG=-AA+SQMQQ*(BB*EL1K10*EL2K10+CC*EL1K20*EL2K20
0798      &              +DD*(EL1K10*EL2K20+EL1K20*EL2K10))
0799             ELSEIF(MSTP(147).EQ.1) THEN
0800                FACQQG=2D0*(-AA+SQMQQ*(BB*EL1K11*EL2K11+CC*EL1K21*EL2K21
0801      &              +DD*(EL1K11*EL2K21+EL1K21*EL2K11)))
0802             ELSEIF(MSTP(147).EQ.3) THEN
0803                FACQQG=-AA+SQMQQ*(BB*EL1K10*EL2K10+CC*EL1K20*EL2K20
0804      &              +DD*(EL1K10*EL2K20+EL1K20*EL2K10))
0805             ELSEIF(MSTP(147).EQ.4) THEN
0806                FACQQG=-AA+SQMQQ*(BB*EL1K11*EL2K11+CC*EL1K21*EL2K21
0807      &              +DD*(EL1K11*EL2K21+EL1K21*EL2K11))
0808             ELSEIF(MSTP(147).EQ.5) THEN
0809                FACQQG=SQMQQ*(BB*EL1K11*EL2K10+CC*EL1K21*EL2K20
0810      &              +DD*(EL1K11*EL2K20+EL1K21*EL2K10))
0811             ELSEIF(MSTP(147).EQ.6) THEN
0812                FACQQG=SQMQQ*(BB*EL1K11*EL2K11+CC*EL1K21*EL2K21
0813      &              +DD*(EL1K11*EL2K21+EL1K21*EL2K11))
0814             ENDIF
0815             FACQQG=COMFAC*FF*FACQQG
0816           ENDIF
0817 C...Split total contribution into different colour flows just like
0818 C...in ISUB.EQ.28 [f + g -> f + g (q + g -> q + g only)]
0819 C...(recalculate kinematics for massless partons).
0820           THP=-0.5D0*SH*(1D0-CTH)
0821           UHP=-0.5D0*SH*(1D0+CTH)
0822           FACQG1=9D0/4D0*(UHP/THP)**2-UHP/SH
0823           FACQG2=9D0/4D0*(SH/THP)**2-SH/UHP
0824           FACQGS=FACQG1+FACQG2
0825           DO 2442 I=MMINA,MMAXA
0826             IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 2442
0827             DO 2441 ISDE=1,2
0828               IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 2441
0829               IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 2441
0830               NCHN=NCHN+1
0831               ISIG(NCHN,ISDE)=I
0832               ISIG(NCHN,3-ISDE)=21
0833               ISIG(NCHN,3)=1
0834               SIGH(NCHN)=FACQQG*PARP(IONIUM+2)*FACQG1/FACQGS
0835               NCHN=NCHN+1
0836               ISIG(NCHN,ISDE)=I
0837               ISIG(NCHN,3-ISDE)=21
0838               ISIG(NCHN,3)=2
0839               SIGH(NCHN)=FACQQG*PARP(IONIUM+2)*FACQG2/FACQGS
0840  2441       CONTINUE
0841  2442     CONTINUE
0842
0843         ELSEIF(ISUB.EQ.426) THEN
0844 C...q + g -> q + QQ~[1S08]
0845           IF(MSTP(145).EQ.0) THEN
0846             FACQQG=-COMFAC*PARU(1)*AS**3*(5D0/18D0)*
0847      &            (SH2+UH2)/(SQMQQR*TH*UHSH2)
0848           ELSE
0849             FA=-PARU(1)*AS**3*(5D0/54D0)*(SH2+UH2)/(SQMQQR*TH*UHSH2)
0850             IF(MSTP(147).EQ.0) THEN
0851                FACQQG=COMFAC*FA
0852             ELSEIF(MSTP(147).EQ.1) THEN
0853                FACQQG=COMFAC*2D0*FA
0854             ELSEIF(MSTP(147).EQ.3) THEN
0855                FACQQG=COMFAC*FA
0856             ELSEIF(MSTP(147).EQ.4) THEN
0857                FACQQG=COMFAC*FA
0858             ELSEIF(MSTP(147).EQ.5) THEN
0859                FACQQG=0D0
0860             ELSEIF(MSTP(147).EQ.6) THEN
0861                FACQQG=0D0
0862             ENDIF
0863           ENDIF
0864 C...Split total contribution into different colour flows just like
0865 C...in ISUB.EQ.28 [f + g -> f + g (q + g -> q + g only)]
0866 C...(recalculate kinematics for massless partons).
0867           THP=-0.5D0*SH*(1D0-CTH)
0868           UHP=-0.5D0*SH*(1D0+CTH)
0869           FACQG1=9D0/4D0*(UHP/THP)**2-UHP/SH
0870           FACQG2=9D0/4D0*(SH/THP)**2-SH/UHP
0871           FACQGS=FACQG1+FACQG2
0872           DO 2444 I=MMINA,MMAXA
0873             IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 2444
0874             DO 2443 ISDE=1,2
0875               IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 2443
0876               IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 2443
0877               NCHN=NCHN+1
0878               ISIG(NCHN,ISDE)=I
0879               ISIG(NCHN,3-ISDE)=21
0880               ISIG(NCHN,3)=1
0881               SIGH(NCHN)=FACQQG*PARP(IONIUM+3)*FACQG1/FACQGS
0882               NCHN=NCHN+1
0883               ISIG(NCHN,ISDE)=I
0884               ISIG(NCHN,3-ISDE)=21
0885               ISIG(NCHN,3)=2
0886               SIGH(NCHN)=FACQQG*PARP(IONIUM+3)*FACQG2/FACQGS
0887  2443       CONTINUE
0888  2444     CONTINUE
0889
0890         ELSEIF(ISUB.EQ.427) THEN
0891 C...q + g -> q + QQ~[3PJ8]
0892           IF(MSTP(145).EQ.0) THEN
0893             FACQQG=-COMFAC*PARU(1)*AS**3*(10D0/9D0)*
0894      &            ((7D0*UHSH+8D0*TH)*(SH2+UH2)
0895      &            +4D0*TH*(2D0*SQMQQ**2-SHTH2-THUH2))/
0896      &            (SQMQQ*SQMQQR*TH*UHSH2*UHSH)
0897           ELSE
0898             FF=10D0*PARU(1)*AS**3/
0899      &            (9D0*SQMQQ*SQMQQR*TH2*UHSH2*UHSH)
0900             AA=TH*UHSH*(2D0*SQMQQ**2+SHTH2+THUH2)
0901             BB=8D0*(SHTH2+TH*UH)
0902             CC=8D0*UHSH*(SHTH+THUH)
0903             DD=4D0*(2D0*SQMQQ*SH+TH*UHSH)
0904             IF(MSTP(147).EQ.0) THEN
0905                FACQQG=-AA+SQMQQ*(BB*EL1K10*EL2K10+CC*EL1K20*EL2K20
0906      &              +DD*(EL1K10*EL2K20+EL1K20*EL2K10))
0907             ELSEIF(MSTP(147).EQ.1) THEN
0908                FACQQG=2D0*(-AA+SQMQQ*(BB*EL1K11*EL2K11+CC*EL1K21*EL2K21
0909      &              +DD*(EL1K11*EL2K21+EL1K21*EL2K11)))
0910             ELSEIF(MSTP(147).EQ.3) THEN
0911                FACQQG=-AA+SQMQQ*(BB*EL1K10*EL2K10+CC*EL1K20*EL2K20
0912      &              +DD*(EL1K10*EL2K20+EL1K20*EL2K10))
0913             ELSEIF(MSTP(147).EQ.4) THEN
0914                FACQQG=-AA+SQMQQ*(BB*EL1K11*EL2K11+CC*EL1K21*EL2K21
0915      &              +DD*(EL1K11*EL2K21+EL1K21*EL2K11))
0916             ELSEIF(MSTP(147).EQ.5) THEN
0917                FACQQG=SQMQQ*(BB*EL1K11*EL2K10+CC*EL1K21*EL2K20
0918      &              +DD*(EL1K11*EL2K20+EL1K21*EL2K10))
0919             ELSEIF(MSTP(147).EQ.6) THEN
0920                FACQQG=SQMQQ*(BB*EL1K11*EL2K11+CC*EL1K21*EL2K21
0921      &              +DD*(EL1K11*EL2K21+EL1K21*EL2K11))
0922             ENDIF
0923             FACQQG=COMFAC*FF*FACQQG
0924           ENDIF
0925 C...Split total contribution into different colour flows just like
0926 C...in ISUB.EQ.28 [f + g -> f + g (q + g -> q + g only)]
0927 C...(recalculate kinematics for massless partons).
0928           THP=-0.5D0*SH*(1D0-CTH)
0929           UHP=-0.5D0*SH*(1D0+CTH)
0930           FACQG1=9D0/4D0*(UHP/THP)**2-UHP/SH
0931           FACQG2=9D0/4D0*(SH/THP)**2-SH/UHP
0932           FACQGS=FACQG1+FACQG2
0933           DO 2446 I=MMINA,MMAXA
0934             IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 2446
0935             DO 2445 ISDE=1,2
0936               IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 2445
0937               IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 2445
0938               NCHN=NCHN+1
0939               ISIG(NCHN,ISDE)=I
0940               ISIG(NCHN,3-ISDE)=21
0941               ISIG(NCHN,3)=1
0942               SIGH(NCHN)=FACQQG*PARP(IONIUM+4)*FACQG1/FACQGS
0943               NCHN=NCHN+1
0944               ISIG(NCHN,ISDE)=I
0945               ISIG(NCHN,3-ISDE)=21
0946               ISIG(NCHN,3)=2
0947               SIGH(NCHN)=FACQQG*PARP(IONIUM+4)*FACQG2/FACQGS
0948  2445       CONTINUE
0949  2446     CONTINUE
0950
0951         ELSEIF(ISUB.EQ.428) THEN
0952 C...q + q~ -> g + QQ~[3S18]
0953           IF(MSTP(145).EQ.0) THEN
0954             FACQQG=COMFAC*PARU(1)*AS**3*(8D0/81D0)*
0955      &            (4D0*(TH2+UH2)-TH*UH)*(SHTH2+UHSH2)/
0956      &            (SQMQQ*SQMQQR*TH*UH*THUH2)
0957           ELSE
0958             FF=-4D0*PARU(1)*AS**3*(4D0*(TH2+UH2)-TH*UH)/
0959      &            (81D0*SQMQQ*SQMQQR*TH*UH*THUH2)
0960             AA=SHTH2+UHSH2
0961             BB=4D0
0962             CC=4D0
0963             DD=0D0
0964             IF(MSTP(147).EQ.0) THEN
0965                FACQQG=-AA+SQMQQ*(BB*EL1K10*EL2K10+CC*EL1K20*EL2K20
0966      &              +DD*(EL1K10*EL2K20+EL1K20*EL2K10))
0967             ELSEIF(MSTP(147).EQ.1) THEN
0968                FACQQG=2D0*(-AA+SQMQQ*(BB*EL1K11*EL2K11+CC*EL1K21*EL2K21
0969      &              +DD*(EL1K11*EL2K21+EL1K21*EL2K11)))
0970             ELSEIF(MSTP(147).EQ.3) THEN
0971                FACQQG=-AA+SQMQQ*(BB*EL1K10*EL2K10+CC*EL1K20*EL2K20
0972      &              +DD*(EL1K10*EL2K20+EL1K20*EL2K10))
0973             ELSEIF(MSTP(147).EQ.4) THEN
0974                FACQQG=-AA+SQMQQ*(BB*EL1K11*EL2K11+CC*EL1K21*EL2K21
0975      &              +DD*(EL1K11*EL2K21+EL1K21*EL2K11))
0976             ELSEIF(MSTP(147).EQ.5) THEN
0977                FACQQG=SQMQQ*(BB*EL1K11*EL2K10+CC*EL1K21*EL2K20
0978      &              +DD*(EL1K11*EL2K20+EL1K21*EL2K10))
0979             ELSEIF(MSTP(147).EQ.6) THEN
0980                FACQQG=SQMQQ*(BB*EL1K11*EL2K11+CC*EL1K21*EL2K21
0981      &              +DD*(EL1K11*EL2K21+EL1K21*EL2K11))
0982             ENDIF
0983             FACQQG=COMFAC*FF*FACQQG
0984           ENDIF
0985 C...Split total contribution into different colour flows just like
0986 C...in ISUB.EQ.13 [f + fbar -> g + g (q + qbar -> g + g only)]
0987 C...(recalculate kinematics for massless partons).
0988           THP=-0.5D0*SH*(1D0-CTH)
0989           UHP=-0.5D0*SH*(1D0+CTH)
0990           FACGG1=UH/TH-9D0/4D0*UH2/SH2
0991           FACGG2=TH/UH-9D0/4D0*TH2/SH2
0992           FACGGS=FACGG1+FACGG2
0993           DO 2447 I=MMINA,MMAXA
0994             IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
0995      &            KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 2447
0996             NCHN=NCHN+1
0997             ISIG(NCHN,1)=I
0998             ISIG(NCHN,2)=-I
0999             ISIG(NCHN,3)=1
1000             SIGH(NCHN)=FACQQG*PARP(IONIUM+2)*FACGG1/FACGGS
1001             NCHN=NCHN+1
1002             ISIG(NCHN,1)=I
1003             ISIG(NCHN,2)=-I
1004             ISIG(NCHN,3)=2
1005             SIGH(NCHN)=FACQQG*PARP(IONIUM+2)*FACGG2/FACGGS
1006  2447     CONTINUE
1007
1008         ELSEIF(ISUB.EQ.429) THEN
1009 C...q + q~ -> g + QQ~[1S08]
1010           IF(MSTP(145).EQ.0) THEN
1011             FACQQG=COMFAC*PARU(1)*AS**3*(20D0/27D0)*
1012      &            (TH2+UH2)/(SQMQQR*SH*THUH2)
1013           ELSE
1014             FA=PARU(1)*AS**3*(20D0/81D0)*(TH2+UH2)/(SQMQQR*SH*THUH2)
1015             IF(MSTP(147).EQ.0) THEN
1016                FACQQG=COMFAC*FA
1017             ELSEIF(MSTP(147).EQ.1) THEN
1018                FACQQG=COMFAC*2D0*FA
1019             ELSEIF(MSTP(147).EQ.3) THEN
1020                FACQQG=COMFAC*FA
1021             ELSEIF(MSTP(147).EQ.4) THEN
1022                FACQQG=COMFAC*FA
1023             ELSEIF(MSTP(147).EQ.5) THEN
1024                FACQQG=0D0
1025             ELSEIF(MSTP(147).EQ.6) THEN
1026                FACQQG=0D0
1027             ENDIF
1028           ENDIF
1029 C...Split total contribution into different colour flows just like
1030 C...in ISUB.EQ.13 [f + fbar -> g + g (q + qbar -> g + g only)]
1031 C...(recalculate kinematics for massless partons).
1032           THP=-0.5D0*SH*(1D0-CTH)
1033           UHP=-0.5D0*SH*(1D0+CTH)
1034           FACGG1=UH/TH-9D0/4D0*UH2/SH2
1035           FACGG2=TH/UH-9D0/4D0*TH2/SH2
1036           FACGGS=FACGG1+FACGG2
1037           DO 2448 I=MMINA,MMAXA
1038             IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
1039      &            KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 2448
1040             NCHN=NCHN+1
1041             ISIG(NCHN,1)=I
1042             ISIG(NCHN,2)=-I
1043             ISIG(NCHN,3)=1
1044             SIGH(NCHN)=FACQQG*PARP(IONIUM+3)*FACGG1/FACGGS
1045             NCHN=NCHN+1
1046             ISIG(NCHN,1)=I
1047             ISIG(NCHN,2)=-I
1048             ISIG(NCHN,3)=2
1049             SIGH(NCHN)=FACQQG*PARP(IONIUM+3)*FACGG2/FACGGS
1050  2448     CONTINUE
1051
1052         ELSEIF(ISUB.EQ.430) THEN
1053 C...q + q~ -> g + QQ~[3PJ8]
1054           IF(MSTP(145).EQ.0) THEN
1055             FACQQG=COMFAC*PARU(1)*AS**3*(80D0/27D0)*
1056      &            ((7D0*THUH+8D0*SH)*(TH2+UH2)
1057      &            +4D0*SH*(2D0*SQMQQ**2-SHTH2-UHSH2))/
1058      &            (SQMQQ*SQMQQR*SH*THUH2*THUH)
1059           ELSE
1060             FF=-80D0*PARU(1)*AS**3/(27D0*SQMQQ*SQMQQR*SH2*THUH2*THUH)
1061             AA=SH*THUH*(2D0*SQMQQ**2+SHTH2+UHSH2)
1062             BB=8D0*(UHSH2+SH*TH)
1063             CC=8D0*(SHTH2+SH*UH)
1064             DD=4D0*(SHTH2+UHSH2+SH*SQMQQ-SQMQQ**2)
1065             IF(MSTP(147).EQ.0) THEN
1066                FACQQG=-AA+SQMQQ*(BB*EL1K10*EL2K10+CC*EL1K20*EL2K20
1067      &              +DD*(EL1K10*EL2K20+EL1K20*EL2K10))
1068             ELSEIF(MSTP(147).EQ.1) THEN
1069                FACQQG=2D0*(-AA+SQMQQ*(BB*EL1K11*EL2K11+CC*EL1K21*EL2K21
1070      &              +DD*(EL1K11*EL2K21+EL1K21*EL2K11)))
1071             ELSEIF(MSTP(147).EQ.3) THEN
1072                FACQQG=-AA+SQMQQ*(BB*EL1K10*EL2K10+CC*EL1K20*EL2K20
1073      &              +DD*(EL1K10*EL2K20+EL1K20*EL2K10))
1074             ELSEIF(MSTP(147).EQ.4) THEN
1075                FACQQG=-AA+SQMQQ*(BB*EL1K11*EL2K11+CC*EL1K21*EL2K21
1076      &              +DD*(EL1K11*EL2K21+EL1K21*EL2K11))
1077             ELSEIF(MSTP(147).EQ.5) THEN
1078                FACQQG=SQMQQ*(BB*EL1K11*EL2K10+CC*EL1K21*EL2K20
1079      &              +DD*(EL1K11*EL2K20+EL1K21*EL2K10))
1080             ELSEIF(MSTP(147).EQ.6) THEN
1081                FACQQG=SQMQQ*(BB*EL1K11*EL2K11+CC*EL1K21*EL2K21
1082      &              +DD*(EL1K11*EL2K21+EL1K21*EL2K11))
1083             ENDIF
1084             FACQQG=COMFAC*FF*FACQQG
1085           ENDIF
1086 C...Split total contribution into different colour flows just like
1087 C...in ISUB.EQ.13 [f + fbar -> g + g (q + qbar -> g + g only)]
1088 C...(recalculate kinematics for massless partons).
1089           THP=-0.5D0*SH*(1D0-CTH)
1090           UHP=-0.5D0*SH*(1D0+CTH)
1091           FACGG1=UH/TH-9D0/4D0*UH2/SH2
1092           FACGG2=TH/UH-9D0/4D0*TH2/SH2
1093           FACGGS=FACGG1+FACGG2
1094           DO 2449 I=MMINA,MMAXA
1095             IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
1096      &            KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 2449
1097             NCHN=NCHN+1
1098             ISIG(NCHN,1)=I
1099             ISIG(NCHN,2)=-I
1100             ISIG(NCHN,3)=1
1101             SIGH(NCHN)=FACQQG*PARP(IONIUM+4)*FACGG1/FACGGS
1102             NCHN=NCHN+1
1103             ISIG(NCHN,1)=I
1104             ISIG(NCHN,2)=-I
1105             ISIG(NCHN,3)=2
1106             SIGH(NCHN)=FACQQG*PARP(IONIUM+4)*FACGG2/FACGGS
1107  2449     CONTINUE
1108
1109         ELSEIF(ISUB.EQ.431) THEN
1110 C...g + g -> QQ~[3P01] + g
1111           PGTW=(SH*TH+TH*UH+UH*SH)/SH2
1112           QGTW=(SH*TH*UH)/SH**3
1113           RGTW=SQMQQ/SH
1114           IF(MSTP(145).EQ.0) THEN
1115             FACQQG=COMFAC*PARU(1)*AS**3*8D0/(9D0*SQMQQR*SH)*
1116      &            (9D0*RGTW**2*PGTW**4*
1117      &            (RGTW**4-2D0*RGTW**2*PGTW+PGTW**2)
1118      &            -6D0*RGTW*PGTW**3*QGTW*
1119      &            (2D0*RGTW**4-5D0*RGTW**2*PGTW+PGTW**2)
1120      &            -PGTW**2*QGTW**2*(RGTW**4+2D0*RGTW**2*PGTW-PGTW**2)
1121      &            +2D0*RGTW*PGTW*QGTW**3*(RGTW**2-PGTW)
1122      &            +6D0*RGTW**2*QGTW**4)/(QGTW*(QGTW-RGTW*PGTW)**4)
1123           ELSE
1124             FC1=PARU(1)*AS**3*8D0/(27D0*SQMQQR*SH)*
1125      &            (9D0*RGTW**2*PGTW**4*
1126      &            (RGTW**4-2D0*RGTW**2*PGTW+PGTW**2)
1127      &            -6D0*RGTW*PGTW**3*QGTW*
1128      &            (2D0*RGTW**4-5D0*RGTW**2*PGTW+PGTW**2)
1129      &            -PGTW**2*QGTW**2*(RGTW**4+2D0*RGTW**2*PGTW-PGTW**2)
1130      &            +2D0*RGTW*PGTW*QGTW**3*(RGTW**2-PGTW)
1131      &            +6D0*RGTW**2*QGTW**4)/(QGTW*(QGTW-RGTW*PGTW)**4)
1132             IF(MSTP(147).EQ.0) THEN
1133                FACQQG=COMFAC*FC1
1134             ELSEIF(MSTP(147).EQ.1) THEN
1135                FACQQG=COMFAC*2D0*FC1
1136             ELSEIF(MSTP(147).EQ.3) THEN
1137                FACQQG=COMFAC*FC1
1138             ELSEIF(MSTP(147).EQ.4) THEN
1139                FACQQG=COMFAC*FC1
1140             ELSEIF(MSTP(147).EQ.5) THEN
1141                FACQQG=0D0
1142             ELSEIF(MSTP(147).EQ.6) THEN
1143                FACQQG=0D0
1144             ENDIF
1145           ENDIF
1146           IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN
1147             NCHN=NCHN+1
1148             ISIG(NCHN,1)=21
1149             ISIG(NCHN,2)=21
1150             ISIG(NCHN,3)=1
1151             SIGH(NCHN)=FACQQG*PARP(IONIUM+5)
1152           ENDIF
1153
1154         ELSEIF(ISUB.EQ.432) THEN
1155 C...g + g -> QQ~[3P11] + g
1156           PGTW=(SH*TH+TH*UH+UH*SH)/SH2
1157           QGTW=(SH*TH*UH)/SH**3
1158           RGTW=SQMQQ/SH
1159           IF(MSTP(145).EQ.0) THEN
1160             FACQQG=COMFAC*PARU(1)*AS**3*8D0/(3D0*SQMQQR*SH)*
1161      &            PGTW**2*(RGTW*PGTW**2*(RGTW**2-4D0*PGTW)
1162      &            +2D0*QGTW*(-RGTW**4+5D0*RGTW**2*PGTW+PGTW**2)
1163      &            -15D0*RGTW*QGTW**2)/(QGTW-RGTW*PGTW)**4
1164           ELSE
1165             FF=4D0/3D0*PARU(1)*AS**3*SQMQQR/SHTH2**2/THUH2**2/UHSH2**2
1166             C1=(4D0*PGTW**5+23D0*PGTW**2*QGTW**2
1167      &            +(-14D0*PGTW**3*QGTW+3D0*QGTW**3)*RGTW
1168      &            -(PGTW**4+2D0*PGTW*QGTW**2)*RGTW**2
1169      &            +3D0*PGTW**2*QGTW*RGTW**3)*SH2**5
1170             C2=2D0*SHTH2*(SH2*THUH*(SH*THUH*(SH-TH)*(SH-UH)
1171      &            -TH*UH*(TH-UH)**2)+SH2**2*(TH-UH)*(TH2+UH2-SH*THUH)
1172      &            *(PGTW**2-QGTW*(SH+2D0*UH)/SH))
1173             C3=2D0*UHSH2*(SH2*THUH*(SH*THUH*(SH-TH)*(SH-UH)
1174      &            -TH*UH*(TH-UH)**2)-SH2**2*(TH-UH)*(TH2+UH2-SH*THUH)
1175      &            *(PGTW**2-QGTW*(SH+2D0*TH)/SH))
1176             C4=-4D0*THUH*(TH-UH)**2*
1177      &            (TH**3*UH**3+SH2**2*(2D0*TH+UH)*(TH+2D0*UH)
1178      &            -SH2*TH*UH*(TH2+UH2))
1179      &            +4D0*THUH2*(SH**3*(SH2**2+TH2**2+UH2**2)
1180      &            -SH*TH*UH*(SH2**2+TH*UH*(TH2-3D0*TH*UH+UH2)
1181      &            +SH2*(5D0*THUH2-17D0*TH*UH)))
1182             IF(MSTP(147).EQ.0) THEN
1183                FACQQG=-C1+C2*EL1K10*EL2K10+C3*EL1K20*EL2K20
1184      &              +C4*(EL1K10*EL2K20+EL1K20*EL2K10)/2D0
1185             ELSEIF(MSTP(147).EQ.1) THEN
1186                FACQQG=2D0*(-C1+C2*EL1K11*EL2K11+C3*EL1K21*EL2K21
1187      &              +C4*(EL1K11*EL2K21+EL1K21*EL2K11)/2D0)
1188             ELSEIF(MSTP(147).EQ.3) THEN
1189                FACQQG=-C1+C2*EL1K10*EL2K10+C3*EL1K20*EL2K20
1190      &              +C4*(EL1K10*EL2K20+EL1K20*EL2K10)/2D0
1191             ELSEIF(MSTP(147).EQ.4) THEN
1192                FACQQG=-C1+C2*EL1K11*EL2K11+C3*EL1K21*EL2K21
1193      &              +C4*(EL1K11*EL2K21+EL1K21*EL2K11)/2D0
1194             ELSEIF(MSTP(147).EQ.5) THEN
1195                FACQQG=C2*EL1K11*EL2K10+C3*EL1K21*EL2K20
1196      &              +C4*(EL1K11*EL2K20+EL1K21*EL2K10)/2D0
1197             ELSEIF(MSTP(147).EQ.6) THEN
1198                FACQQG=C2*EL1K11*EL2K11+C3*EL1K21*EL2K21
1199      &              +C4*(EL1K11*EL2K21+EL1K21*EL2K11)/2D0
1200             ENDIF
1201             FACQQG=COMFAC*FF*FACQQG
1202           ENDIF
1203           IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN
1204             NCHN=NCHN+1
1205             ISIG(NCHN,1)=21
1206             ISIG(NCHN,2)=21
1207             ISIG(NCHN,3)=1
1208             SIGH(NCHN)=FACQQG*PARP(IONIUM+5)
1209           ENDIF
1210
1211         ELSEIF(ISUB.EQ.433) THEN
1212 C...g + g -> QQ~[3P21] + g
1213           PGTW=(SH*TH+TH*UH+UH*SH)/SH2
1214           QGTW=(SH*TH*UH)/SH**3
1215           RGTW=SQMQQ/SH
1216           IF(MSTP(145).EQ.0) THEN
1217             FACQQG=COMFAC*PARU(1)*AS**3*8D0/(9D0*SQMQQR*SH)*
1218      &            (12D0*RGTW**2*PGTW**4*
1219      &            (RGTW**4-2D0*RGTW**2*PGTW+PGTW**2)
1220      &            -3D0*RGTW*PGTW**3*QGTW*
1221      &            (8D0*RGTW**4-RGTW**2*PGTW+4D0*PGTW**2)
1222      &            +2D0*PGTW**2*QGTW**2*
1223      &            (-7D0*RGTW**4+43D0*RGTW**2*PGTW+PGTW**2)
1224      &            +RGTW*PGTW*QGTW**3*(16D0*RGTW**2-61D0*PGTW)
1225      &            +12D0*RGTW**2*QGTW**4)/(QGTW*(QGTW-RGTW*PGTW)**4)
1226           ELSE
1227             FF=(16D0*PARU(1)*AS**3*SQMQQ*SQMQQR)/
1228      &            (3D0*SH2*TH2*UH2*SHTH2**2*THUH2**2*UHSH2**2)
1229             C1=PGTW**2*QGTW*(PGTW*RGTW-QGTW)**2*(RGTW**2-2D0*PGTW)
1230      &            *SH*SH2**7
1231             C2=2D0*SHTH2*(-SH2**3*TH2**3-SH**5*TH**5*UH*SHTH
1232      &            +SH2**2*TH2**2*UH2*(8D0*SHTH2-5D0*SH*TH)
1233      &            +SH**3*TH**3*UH**3*SHTH*(17D0*SHTH2-2D0*SH*TH)
1234      &            +SH2*TH2*UH2**2*(105D0*SH2*TH2+64D0*SH*TH*(SH2+TH2)
1235      &            +10D0*(SH2**2+TH2**2))
1236      &            +SH2*TH2*UH**5*SHTH*(32D0*SHTH2+7D0*SH*TH)
1237      &            -UH2**3*(SH2**3-87D0*SH**3*TH**3+TH2**3
1238      &            -45D0*SH2*TH2*(SH2+TH2)-5D0*SH*TH*(SH2**2+TH2**2))
1239      &            +SH*TH*UH**7*SHTH*(7D0*SHTH2+12D0*SH*TH)
1240      &            +4D0*SH*TH*UH2**4*SHTH2)
1241             C3=2D0*UHSH2*(-SH2**3*UH2**3-SH**5*UH**5*TH*UHSH
1242      &            +SH2**2*UH2**2*TH2*(8D0*UHSH2-5D0*SH*UH)
1243      &            +SH**3*UH**3*TH**3*UHSH*(17D0*UHSH2-2D0*SH*UH)
1244      &            +SH2*UH2*TH2**2*(105D0*SH2*UH2+64D0*SH*UH*(SH2+UH2)
1245      &            +10D0*(SH2**2+UH2**2))
1246      &            +SH2*UH2*TH**5*UHSH*(32D0*UHSH2+7D0*SH*UH)
1247      &            -TH2**3*(SH2**3-87D0*SH**3*UH**3+UH2**3
1248      &            -45D0*SH2*UH2*(SH2+UH2)-5D0*SH*UH*(SH2**2+UH2**2))
1249      &            +SH*UH*TH**7*UHSH*(7D0*UHSH2+12D0*SH*UH)
1250      &            +4D0*SH*UH*TH2**4*UHSH2)
1251             C4=-2D0*SHTH*UHSH*(-2D0*TH2**3*UH2**3
1252      &            -SH**5*TH2*UH2*THUH*(5D0*TH+3D0*UH)*(3D0*TH+5D0*UH)
1253      &            +SH2**3*(2D0*TH+UH)*(TH+2D0*UH)*(TH2-UH2)**2
1254      &            -SH*TH2**2*UH2**2*THUH*(5D0*THUH2-4D0*TH*UH)
1255      &            -SH2*TH**3*UH**3*THUH2*(13D0*THUH2-16D0*TH*UH)
1256      &            -SH**3*TH2*UH2*(92D0*TH2*UH2*THUH
1257      &            +53D0*TH*UH*(TH**3+UH**3)+11D0*(TH**5+UH**5))
1258      &            -SH2**2*TH*UH*(114D0*TH**3*UH**3
1259      &            +83D0*TH2*UH2*(TH2+UH2)+28D0*TH*UH*(TH2**2+UH2**2)
1260      &            +3D0*(TH2**3+UH2**3)))
1261             C5=4D0*SH*TH*UH2*SHTH2*(2D0*SH*TH+SH*UH+TH*UH)**2
1262      &            *(2D0*UH*SQMQQ**2+SHTH*(SH*TH-UH2))
1263             C6=4D0*SH*UH*TH2*UHSH2*(2D0*SH*UH+SH*TH+TH*UH)**2
1264      &            *(2D0*TH*SQMQQ**2+UHSH*(SH*UH-TH2))
1265             C7=4D0*SH*TH*UH2*SHTH*(SH2**2*TH**3*(11D0*SH+16D0*TH)
1266      &            +SH**3*TH2*UH*(31D0*SH2+83D0*SH*TH+61D0*TH2)
1267      &            +SH2*TH*UH2*(19D0*SH**3+110D0*SH2*TH+156D0*SH*TH2+
1268      &            82D0*TH**3)
1269      &            +SH*TH*UH**3*(43D0*SH**3+132D0*SH2*TH+124D0*SH*TH2
1270      &            +45D0*TH**3)
1271      &            +TH*UH2**2*(37D0*SH**3+68D0*SH2*TH+43D0*SH*TH2+
1272      &            8D0*TH**3)
1273      &            +TH*UH**5*(11D0*SH2+13D0*SH*TH+5D0*TH2)
1274      &            +SH**3*UH**3*(3D0*UHSH2-2D0*SH*UH)
1275      &            +TH**5*UHSH*(5D0*UHSH2+2D0*SH*UH))
1276             C8=4D0*SH*UH*TH2*UHSH*(SH2**2*UH**3*(11D0*SH+16D0*UH)
1277      &            +SH**3*UH2*TH*(31D0*SH2+83D0*SH*UH+61D0*UH2)
1278      &            +SH2*UH*TH2*(19D0*SH**3+110D0*SH2*UH+156D0*SH*UH2+
1279      &            82D0*UH**3)
1280      &            +SH*UH*TH**3*(43D0*SH**3+132D0*SH2*UH+124D0*SH*UH2
1281      &            +45D0*UH**3)
1282      &            +UH*TH2**2*(37D0*SH**3+68D0*SH2*UH+43D0*SH*UH2+
1283      &            8D0*UH**3)
1284      &            +UH*TH**5*(11D0*SH2+13D0*SH*UH+5D0*UH2)
1285      &            +SH**3*TH**3*(3D0*SHTH2-2D0*SH*TH)
1286      &            +UH**5*SHTH*(5D0*SHTH2+2D0*SH*TH))
1287             C9=4D0*SHTH*UHSH*(2D0*TH**5*UH**5*THUH
1288      &            +4D0*SH*TH2**2*UH2**2*THUH2
1289      &            -SH2*TH**3*UH**3*THUH*(TH2+UH2)
1290      &            -2D0*SH**3*TH2*UH2*(THUH2**2+2D0*TH*UH*THUH2-TH2*UH2)
1291      &            +SH2**2*TH*UH*THUH*(-TH*UH*THUH2+3D0*(TH2**2+UH2**2))
1292      &            +SH**5*(4D0*TH2*UH2*(THUH2-TH*UH)
1293      &            +5D0*TH*UH*(TH2**2+UH2**2)+2D0*(TH2**3+UH2**3)))
1294             C0=-4D0*(2D0*TH2**3*UH2**3*SQMQQ
1295      &            -SH2*TH2**2*UH2**2*THUH*(19D0*THUH2-4D0*TH*UH)
1296      &            -SH**3*TH**3*UH**3*THUH2*(32D0*THUH2+29D0*TH*UH)
1297      &            -SH2**2*TH2*UH2*THUH*(264D0*TH2*UH2
1298      &            +136D0*TH*UH*(TH2+UH2)+15D0*(TH2**2+UH2**2))
1299      &            +SH**5*TH*UH*(-428D0*TH**3*UH**3
1300      &            -256D0*TH2*UH2*(TH2+UH2)-43D0*TH*UH*(TH2**2+UH2**2)
1301      &            +2D0*(TH2**3+UH2**3))
1302      &            +SH**7*(-46D0*TH**3*UH**3-21D0*TH2*UH2*(TH2+UH2)
1303      &            +2D0*TH*UH*(TH2**2+UH2**2)+2D0*(TH2**3+UH2**3))
1304      &            +SH2**3*THUH*(-134*TH**3*UH**3-53D0*TH2*UH2*(TH2+UH2)
1305      &            +4D0*TH*UH*(TH2**2+UH2**2)+2D0*(TH2**3+UH2**3)))
1306             IF(MSTP(147).EQ.0) THEN
1307                FACQQG=1D0/3D0*(C1*3D0
1308      &              -C2*(2D0*EL1K10*EL2K10+EL1K11*EL2K11)
1309      &              -C3*(2D0*EL1K20*EL2K20+EL1K21*EL2K21)
1310      &              -C4*(2D0*EL1K10*EL2K20+EL1K11*EL2K21)
1311      &              +C5*2D0*(EL1K10*EL2K10-EL1K11*EL2K11)**2
1312      &              +C6*2D0*(EL1K20*EL2K20-EL1K21*EL2K21)**2
1313      &              +C7*2D0*(EL1K10*EL2K10-EL1K11*EL2K11)
1314      &                     *(EL1K10*EL2K20-EL1K11*EL2K21)
1315      &              +C8*2D0*(EL1K20*EL2K20-EL1K21*EL2K21)
1316      &                     *(EL1K10*EL2K20-EL1K11*EL2K21)
1317      &              +C9*2D0*(EL1K10*EL2K10-EL1K11*EL2K11)
1318      &                     *(EL1K20*EL2K20-EL1K21*EL2K21)
1319      &              +C0*2D0*(EL1K10*EL2K20-EL1K11*EL2K21)**2)
1320             ELSEIF(MSTP(147).EQ.1) THEN
1321                FACQQG=C1*2D0
1322      &              -C2*(EL1K10*EL2K10+EL1K11*EL2K11)
1323      &              -C3*(EL1K20*EL2K20+EL1K21*EL2K21)
1324      &              -C4*(EL1K10*EL2K20+EL1K11*EL2K21)
1325      &              +C5*4D0*EL1K10*EL2K10*EL1K11*EL2K11
1326      &              +C6*4D0*EL1K20*EL2K20*EL1K21*EL2K21
1327      &              +C7*2D0*(EL1K10*EL2K10*EL1K11*EL2K21
1328      &                      +EL1K10*EL2K20*EL1K11*EL2K11)
1329      &              +C8*2D0*(EL1K20*EL2K20*EL1K11*EL2K21
1330      &                      +EL1K10*EL2K20*EL1K21*EL2K21)
1331      &              +C9*4D0*EL1K10*EL2K20*EL1K11*EL2K21
1332      &              +C0*(EL1K10*EL2K10*EL1K21*EL2K21
1333      &              +2D0*EL1K10*EL2K20*EL1K11*EL2K21
1334      &                  +EL1K20*EL2K20*EL1K11*EL2K11)
1335             ELSEIF(MSTP(147).EQ.2) THEN
1336                FACQQG=2D0*(C1
1337      &              -C2*EL1K11*EL2K11
1338      &              -C3*EL1K21*EL2K21
1339      &              -C4*EL1K11*EL2K21
1340      &              +C5*(EL1K11*EL2K11)**2
1341      &              +C6*(EL1K21*EL2K21)**2
1342      &              +C7*EL1K11*EL2K11*EL1K11*EL2K21
1343      &              +C8*EL1K21*EL2K21*EL1K11*EL2K21
1344      &              +(C9+C0)*(EL1K11*EL2K21)**2)
1345             ENDIF
1346             FACQQG=COMFAC*FF*FACQQG
1347           ENDIF
1348           IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN
1349             NCHN=NCHN+1
1350             ISIG(NCHN,1)=21
1351             ISIG(NCHN,2)=21
1352             ISIG(NCHN,3)=1
1353             SIGH(NCHN)=FACQQG*PARP(IONIUM+5)
1354           ENDIF
1355
1356         ELSEIF(ISUB.EQ.434) THEN
1357 C...q + g -> q + QQ~[3P01]
1358           IF(MSTP(145).EQ.0) THEN
1359             FACQQG=-COMFAC*PARU(1)*AS**3*(16D0/81D0)*
1360      &            (TH-3D0*SQMQQ)**2*(SH2+UH2)/(SQMQQR*TH*UHSH2**2)
1361           ELSE
1362             FA=-PARU(1)*AS**3*(16D0/243D0)*
1363      &            (TH-3D0*SQMQQ)**2*(SH2+UH2)/(SQMQQR*TH*UHSH2**2)
1364             IF(MSTP(147).EQ.0) THEN
1365                FACQQG=COMFAC*FA
1366             ELSEIF(MSTP(147).EQ.1) THEN
1367                FACQQG=COMFAC*2D0*FA
1368             ELSEIF(MSTP(147).EQ.3) THEN
1369                FACQQG=COMFAC*FA
1370             ELSEIF(MSTP(147).EQ.4) THEN
1371                FACQQG=COMFAC*FA
1372             ELSEIF(MSTP(147).EQ.5) THEN
1373                FACQQG=0D0
1374             ELSEIF(MSTP(147).EQ.6) THEN
1375                FACQQG=0D0
1376             ENDIF
1377           ENDIF
1378           DO 2452 I=MMINA,MMAXA
1379             IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 2452
1380             DO 2451 ISDE=1,2
1381               IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 2451
1382               IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 2451
1383               NCHN=NCHN+1
1384               ISIG(NCHN,ISDE)=I
1385               ISIG(NCHN,3-ISDE)=21
1386               ISIG(NCHN,3)=1
1387               SIGH(NCHN)=FACQQG*PARP(IONIUM+5)
1388  2451       CONTINUE
1389  2452     CONTINUE
1390
1391         ELSEIF(ISUB.EQ.435) THEN
1392 C...q + g -> q + QQ~[3P11]
1393           IF(MSTP(145).EQ.0) THEN
1394             FACQQG=-COMFAC*PARU(1)*AS**3*(32D0/27D0)*
1395      &            (4D0*SQMQQ*SH*UH+TH*(SH2+UH2))/(SQMQQR*UHSH2**2)
1396           ELSE
1397             FF=(64D0*PARU(1)*AS**3*SQMQQR)/(27D0*UHSH2**2)
1398             C1=SH*UH
1399             C2=2D0*SH
1400             C3=0D0
1401             C4=2D0*(SH-UH)
1402             IF(MSTP(147).EQ.0) THEN
1403                FACQQG=-C1+C2*EL1K10*EL2K10+C3*EL1K20*EL2K20
1404      &              +C4*(EL1K10*EL2K20+EL1K20*EL2K10)/2D0
1405             ELSEIF(MSTP(147).EQ.1) THEN
1406                FACQQG=2D0*(-C1+C2*EL1K11*EL2K11+C3*EL1K21*EL2K21
1407      &              +C4*(EL1K11*EL2K21+EL1K21*EL2K11)/2D0)
1408             ELSEIF(MSTP(147).EQ.3) THEN
1409                FACQQG=-C1+C2*EL1K10*EL2K10+C3*EL1K20*EL2K20
1410      &              +C4*(EL1K10*EL2K20+EL1K20*EL2K10)/2D0
1411             ELSEIF(MSTP(147).EQ.4) THEN
1412                FACQQG=-C1+C2*EL1K11*EL2K11+C3*EL1K21*EL2K21
1413      &              +C4*(EL1K11*EL2K21+EL1K21*EL2K11)/2D0
1414             ELSEIF(MSTP(147).EQ.5) THEN
1415                FACQQG=C2*EL1K11*EL2K10+C3*EL1K21*EL2K20
1416      &              +C4*(EL1K11*EL2K20+EL1K21*EL2K10)/2D0
1417             ELSEIF(MSTP(147).EQ.6) THEN
1418                FACQQG=C2*EL1K11*EL2K11+C3*EL1K21*EL2K21
1419      &              +C4*(EL1K11*EL2K21+EL1K21*EL2K11)/2D0
1420             ENDIF
1421             FACQQG=COMFAC*FF*FACQQG
1422           ENDIF
1423           DO 2454 I=MMINA,MMAXA
1424             IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 2454
1425             DO 2453 ISDE=1,2
1426               IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 2453
1427               IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 2453
1428               NCHN=NCHN+1
1429               ISIG(NCHN,ISDE)=I
1430               ISIG(NCHN,3-ISDE)=21
1431               ISIG(NCHN,3)=1
1432               SIGH(NCHN)=FACQQG*PARP(IONIUM+5)
1433  2453       CONTINUE
1434  2454     CONTINUE
1435
1436         ELSEIF(ISUB.EQ.436) THEN
1437 C...q + g -> q + QQ~[3P21]
1438           IF(MSTP(145).EQ.0) THEN
1439             FACQQG=-COMFAC*PARU(1)*AS**3*(32D0/81D0)*
1440      &            ((6D0*SQMQQ**2+TH2)*UHSH2
1441      &            -2D0*SH*UH*(TH2+6D0*SQMQQ*UHSH))/
1442      &            (SQMQQR*TH*UHSH2**2)
1443           ELSE
1444             FF=-(32D0*PARU(1)*AS**3*SQMQQ*SQMQQR)/(27D0*TH2*UHSH2**2)
1445             C1=TH*UHSH2
1446             C2=4D0*(SH2+TH2+2D0*TH*UHSH)
1447             C3=4D0*UHSH2
1448             C4=8D0*SH*UHSH
1449             C5=8D0*TH
1450             C6=0D0
1451             C7=16D0*TH
1452             C8=0D0
1453             C9=-16D0*UHSH
1454             C0=16D0*SQMQQ
1455             IF(MSTP(147).EQ.0) THEN
1456                FACQQG=1D0/3D0*(C1*3D0
1457      &              -C2*(2D0*EL1K10*EL2K10+EL1K11*EL2K11)
1458      &              -C3*(2D0*EL1K20*EL2K20+EL1K21*EL2K21)
1459      &              -C4*(2D0*EL1K10*EL2K20+EL1K11*EL2K21)
1460      &              +C5*2D0*(EL1K10*EL2K10-EL1K11*EL2K11)**2
1461      &              +C6*2D0*(EL1K20*EL2K20-EL1K21*EL2K21)**2
1462      &              +C7*2D0*(EL1K10*EL2K10-EL1K11*EL2K11)
1463      &                     *(EL1K10*EL2K20-EL1K11*EL2K21)
1464      &              +C8*2D0*(EL1K20*EL2K20-EL1K21*EL2K21)
1465      &                     *(EL1K10*EL2K20-EL1K11*EL2K21)
1466      &              +C9*2D0*(EL1K10*EL2K10-EL1K11*EL2K11)
1467      &                     *(EL1K20*EL2K20-EL1K21*EL2K21)
1468      &              +C0*2D0*(EL1K10*EL2K20-EL1K11*EL2K21)**2)
1469             ELSEIF(MSTP(147).EQ.1) THEN
1470                FACQQG=C1*2D0
1471      &              -C2*(EL1K10*EL2K10+EL1K11*EL2K11)
1472      &              -C3*(EL1K20*EL2K20+EL1K21*EL2K21)
1473      &              -C4*(EL1K10*EL2K20+EL1K11*EL2K21)
1474      &              +C5*4D0*EL1K10*EL2K10*EL1K11*EL2K11
1475      &              +C6*4D0*EL1K20*EL2K20*EL1K21*EL2K21
1476      &              +C7*2D0*(EL1K10*EL2K10*EL1K11*EL2K21
1477      &                      +EL1K10*EL2K20*EL1K11*EL2K11)
1478      &              +C8*2D0*(EL1K20*EL2K20*EL1K11*EL2K21
1479      &                      +EL1K10*EL2K20*EL1K21*EL2K21)
1480      &              +C9*4D0*EL1K10*EL2K20*EL1K11*EL2K21
1481      &              +C0*(EL1K10*EL2K10*EL1K21*EL2K21
1482      &              +2D0*EL1K10*EL2K20*EL1K11*EL2K21
1483      &                  +EL1K20*EL2K20*EL1K11*EL2K11)
1484             ELSEIF(MSTP(147).EQ.2) THEN
1485                FACQQG=2D0*(C1
1486      &              -C2*EL1K11*EL2K11
1487      &              -C3*EL1K21*EL2K21
1488      &              -C4*EL1K11*EL2K21
1489      &              +C5*(EL1K11*EL2K11)**2
1490      &              +C6*(EL1K21*EL2K21)**2
1491      &              +C7*EL1K11*EL2K11*EL1K11*EL2K21
1492      &              +C8*EL1K21*EL2K21*EL1K11*EL2K21
1493      &              +(C9+C0)*(EL1K11*EL2K21)**2)
1494             ENDIF
1495             FACQQG=COMFAC*FF*FACQQG
1496           ENDIF
1497           DO 2456 I=MMINA,MMAXA
1498             IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 2456
1499             DO 2455 ISDE=1,2
1500               IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 2455
1501               IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 2455
1502               NCHN=NCHN+1
1503               ISIG(NCHN,ISDE)=I
1504               ISIG(NCHN,3-ISDE)=21
1505               ISIG(NCHN,3)=1
1506               SIGH(NCHN)=FACQQG*PARP(IONIUM+5)
1507  2455       CONTINUE
1508  2456     CONTINUE
1509
1510         ELSEIF(ISUB.EQ.437) THEN
1511 C...q + q~ -> g + QQ~[3P01]
1512           IF(MSTP(145).EQ.0) THEN
1513             FACQQG=COMFAC*PARU(1)*AS**3*(128D0/243D0)*
1514      &            (SH-3D0*SQMQQ)**2*(TH2+UH2)/(SQMQQR*SH*THUH2**2)
1515           ELSE
1516             FA=PARU(1)*AS**3*(128D0/729D0)*
1517      &            (SH-3D0*SQMQQ)**2*(TH2+UH2)/(SQMQQR*SH*THUH2**2)
1518             IF(MSTP(147).EQ.0) THEN
1519                FACQQG=COMFAC*FA
1520             ELSEIF(MSTP(147).EQ.1) THEN
1521                FACQQG=COMFAC*2D0*FA
1522             ELSEIF(MSTP(147).EQ.3) THEN
1523                FACQQG=COMFAC*FA
1524             ELSEIF(MSTP(147).EQ.4) THEN
1525                FACQQG=COMFAC*FA
1526             ELSEIF(MSTP(147).EQ.5) THEN
1527                FACQQG=0D0
1528             ELSEIF(MSTP(147).EQ.6) THEN
1529                FACQQG=0D0
1530             ENDIF
1531           ENDIF
1532           DO 2457 I=MMINA,MMAXA
1533             IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
1534      &      KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 2457
1535             NCHN=NCHN+1
1536             ISIG(NCHN,1)=I
1537             ISIG(NCHN,2)=-I
1538             ISIG(NCHN,3)=1
1539             SIGH(NCHN)=FACQQG*PARP(IONIUM+5)
1540  2457     CONTINUE
1541
1542         ELSEIF(ISUB.EQ.438) THEN
1543 C...q + q~ -> g + QQ~[3P11]
1544           IF(MSTP(145).EQ.0) THEN
1545             FACQQG=COMFAC*PARU(1)*AS**3*256D0/81D0*
1546      &            (4D0*SQMQQ*TH*UH+SH*(TH2+UH2))/(SQMQQR*THUH2**2)
1547           ELSE
1548             FF=-(512D0*PARU(1)*AS**3*SQMQQR)/(81D0*THUH2**2)
1549             C1=TH*UH
1550             C2=2D0*UH
1551             C3=2D0*TH
1552             C4=2D0*THUH
1553             IF(MSTP(147).EQ.0) THEN
1554                FACQQG=-C1+C2*EL1K10*EL2K10+C3*EL1K20*EL2K20
1555      &              +C4*(EL1K10*EL2K20+EL1K20*EL2K10)/2D0
1556             ELSEIF(MSTP(147).EQ.1) THEN
1557                FACQQG=2D0*(-C1+C2*EL1K11*EL2K11+C3*EL1K21*EL2K21
1558      &              +C4*(EL1K11*EL2K21+EL1K21*EL2K11)/2D0)
1559             ELSEIF(MSTP(147).EQ.3) THEN
1560                FACQQG=-C1+C2*EL1K10*EL2K10+C3*EL1K20*EL2K20
1561      &              +C4*(EL1K10*EL2K20+EL1K20*EL2K10)/2D0
1562             ELSEIF(MSTP(147).EQ.4) THEN
1563                FACQQG=-C1+C2*EL1K11*EL2K11+C3*EL1K21*EL2K21
1564      &              +C4*(EL1K11*EL2K21+EL1K21*EL2K11)/2D0
1565             ELSEIF(MSTP(147).EQ.5) THEN
1566                FACQQG=C2*EL1K11*EL2K10+C3*EL1K21*EL2K20
1567      &              +C4*(EL1K11*EL2K20+EL1K21*EL2K10)/2D0
1568             ELSEIF(MSTP(147).EQ.6) THEN
1569                FACQQG=C2*EL1K11*EL2K11+C3*EL1K21*EL2K21
1570      &              +C4*(EL1K11*EL2K21+EL1K21*EL2K11)/2D0
1571             ENDIF
1572             FACQQG=COMFAC*FF*FACQQG
1573           ENDIF
1574           DO 2458 I=MMINA,MMAXA
1575             IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
1576      &      KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 2458
1577             NCHN=NCHN+1
1578             ISIG(NCHN,1)=I
1579             ISIG(NCHN,2)=-I
1580             ISIG(NCHN,3)=1
1581             SIGH(NCHN)=FACQQG*PARP(IONIUM+5)
1582  2458     CONTINUE
1583
1584         ELSEIF(ISUB.EQ.439) THEN
1585 C...q + q~ -> g + QQ~[3P21]
1586           IF(MSTP(145).EQ.0) THEN
1587             FACQQG=COMFAC*PARU(1)*AS**3*(256D0/243D0)*
1588      &            ((6D0*SQMQQ**2+SH2)*THUH2
1589      &            -2D0*TH*UH*(SH2+6D0*SQMQQ*THUH))/
1590      &            (SQMQQR*SH*THUH2**2)
1591           ELSE
1592             FF=(256D0*PARU(1)*AS**3*SQMQQ*SQMQQR)/(81D0*SH2*THUH2**2)
1593             C1=SH*THUH2
1594             C2=4D0*(SH2+UH2+2D0*SH*THUH)
1595             C3=4D0*(SH2+TH2+2D0*SH*THUH)
1596             C4=8D0*(SH2-TH*UH+2D0*SH*THUH)
1597             C5=8D0*SH
1598             C6=C5
1599             C7=16D0*SH
1600             C8=C7
1601             C9=-16D0*THUH
1602             C0=16D0*SQMQQ
1603             IF(MSTP(147).EQ.0) THEN
1604                FACQQG=1D0/3D0*(C1*3D0
1605      &              -C2*(2D0*EL1K10*EL2K10+EL1K11*EL2K11)
1606      &              -C3*(2D0*EL1K20*EL2K20+EL1K21*EL2K21)
1607      &              -C4*(2D0*EL1K10*EL2K20+EL1K11*EL2K21)
1608      &              +C5*2D0*(EL1K10*EL2K10-EL1K11*EL2K11)**2
1609      &              +C6*2D0*(EL1K20*EL2K20-EL1K21*EL2K21)**2
1610      &              +C7*2D0*(EL1K10*EL2K10-EL1K11*EL2K11)
1611      &                     *(EL1K10*EL2K20-EL1K11*EL2K21)
1612      &              +C8*2D0*(EL1K20*EL2K20-EL1K21*EL2K21)
1613      &                     *(EL1K10*EL2K20-EL1K11*EL2K21)
1614      &              +C9*2D0*(EL1K10*EL2K10-EL1K11*EL2K11)
1615      &                     *(EL1K20*EL2K20-EL1K21*EL2K21)
1616      &              +C0*2D0*(EL1K10*EL2K20-EL1K11*EL2K21)**2)
1617             ELSEIF(MSTP(147).EQ.1) THEN
1618                FACQQG=C1*2D0
1619      &              -C2*(EL1K10*EL2K10+EL1K11*EL2K11)
1620      &              -C3*(EL1K20*EL2K20+EL1K21*EL2K21)
1621      &              -C4*(EL1K10*EL2K20+EL1K11*EL2K21)
1622      &              +C5*4D0*EL1K10*EL2K10*EL1K11*EL2K11
1623      &              +C6*4D0*EL1K20*EL2K20*EL1K21*EL2K21
1624      &              +C7*2D0*(EL1K10*EL2K10*EL1K11*EL2K21
1625      &                      +EL1K10*EL2K20*EL1K11*EL2K11)
1626      &              +C8*2D0*(EL1K20*EL2K20*EL1K11*EL2K21
1627      &                      +EL1K10*EL2K20*EL1K21*EL2K21)
1628      &              +C9*4D0*EL1K10*EL2K20*EL1K11*EL2K21
1629      &              +C0*(EL1K10*EL2K10*EL1K21*EL2K21
1630      &              +2D0*EL1K10*EL2K20*EL1K11*EL2K21
1631      &                  +EL1K20*EL2K20*EL1K11*EL2K11)
1632             ELSEIF(MSTP(147).EQ.2) THEN
1633                FACQQG=2D0*(C1
1634      &              -C2*EL1K11*EL2K11
1635      &              -C3*EL1K21*EL2K21
1636      &              -C4*EL1K11*EL2K21
1637      &              +C5*(EL1K11*EL2K11)**2
1638      &              +C6*(EL1K21*EL2K21)**2
1639      &              +C7*EL1K11*EL2K11*EL1K11*EL2K21
1640      &              +C8*EL1K21*EL2K21*EL1K11*EL2K21
1641      &              +(C9+C0)*(EL1K11*EL2K21)**2)
1642             ENDIF
1643             FACQQG=COMFAC*FF*FACQQG
1644           ENDIF
1645           DO 2459 I=MMINA,MMAXA
1646             IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
1647      &      KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 2459
1648             NCHN=NCHN+1
1649             ISIG(NCHN,1)=I
1650             ISIG(NCHN,2)=-I
1651             ISIG(NCHN,3)=1
1652             SIGH(NCHN)=FACQQG*PARP(IONIUM+5)
1653  2459     CONTINUE
1654         ENDIF
1655 C...QUARKONIA---
1656
1657       ENDIF
1658
1659       RETURN
1660       END