pythiaeRHIC/pythia/pysgex.f

0001
0002 C*********************************************************************
0003
0004 C...PYSGEX
0005 C...Subprocess cross sections for assorted exotic processes,
0006 C...including Z'/W'/LQ/R/f*/H++/Z_R/W_R/G*.
0007 C...Auxiliary to PYSIGH.
0008
0009       SUBROUTINE PYSGEX(NCHN,SIGS)
0010
0011 C...Double precision and integer declarations
0012       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0013       IMPLICIT INTEGER(I-N)
0014       INTEGER PYK,PYCHGE,PYCOMP
0015 C...Parameter statement to help give large particle numbers.
0016       PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000,
0017      &KEXCIT=4000000,KDIMEN=5000000)
0018 C...Commonblocks
0019       COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0020       COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
0021       COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5)
0022       COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
0023       COMMON/PYINT1/MINT(400),VINT(400)
0024       COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2)
0025       COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000)
0026       COMMON/PYINT4/MWID(500),WIDS(500,5)
0027       COMMON/PYTCSM/ITCM(0:99),RTCM(0:99)
0028       COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA,
0029      &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4,
0030      &SHR,SQPTH,TAUP,BE34,CTH,X(2),SQMZ,SQMW,GMMZ,GMMW,
0031      &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR
0032       SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYPARS/,/PYINT1/,/PYINT2/,
0033      &/PYINT3/,/PYINT4/,/PYTCSM/,/PYSGCM/
0034 C...Local arrays
0035       DIMENSION WDTP(0:400),WDTE(0:400,0:5)
0036
0037 C...Differential cross section expressions.
0038
0039       IF(ISUB.LE.160) THEN
0040         IF(ISUB.EQ.141) THEN
0041 C...f + fbar -> gamma*/Z0/Z'0
0042           SQMZP=PMAS(32,1)**2
0043           MINT(61)=2
0044           CALL PYWIDT(32,SH,WDTP,WDTE)
0045           HP0=AEM/3D0*SH
0046           HP1=AEM/3D0*XWC*SH
0047           HP2=HP1
0048           HS=SHR*VINT(117)
0049           HSP=SHR*WDTP(0)
0050           FACZP=4D0*COMFAC*3D0
0051           DO 100 I=MMINA,MMAXA
0052             IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 100
0053             EI=KCHG(IABS(I),1)/3D0
0054             AI=SIGN(1D0,EI)
0055             VI=AI-4D0*EI*XWV
0056             IA=IABS(I)
0057             IF(IA.LT.10) THEN
0058               IF(IA.LE.2) THEN
0059                 VPI=PARU(123-2*MOD(IABS(I),2))
0060                 API=PARU(124-2*MOD(IABS(I),2))
0061               ELSEIF(IA.LE.4) THEN
0062                 VPI=PARJ(182-2*MOD(IABS(I),2))
0063                 API=PARJ(183-2*MOD(IABS(I),2))
0064               ELSE
0065                 VPI=PARJ(190-2*MOD(IABS(I),2))
0066                 API=PARJ(191-2*MOD(IABS(I),2))
0067               ENDIF
0068             ELSE
0069               IF(IA.LE.12) THEN
0070                 VPI=PARU(127-2*MOD(IABS(I),2))
0071                 API=PARU(128-2*MOD(IABS(I),2))
0072               ELSEIF(IA.LE.14) THEN
0073                 VPI=PARJ(186-2*MOD(IABS(I),2))
0074                 API=PARJ(187-2*MOD(IABS(I),2))
0075               ELSE
0076                 VPI=PARJ(194-2*MOD(IABS(I),2))
0077                 API=PARJ(195-2*MOD(IABS(I),2))
0078               ENDIF
0079             ENDIF
0080             HI0=HP0
0081             IF(IABS(I).LE.10) HI0=HI0*FACA/3D0
0082             HI1=HP1
0083             IF(IABS(I).LE.10) HI1=HI1*FACA/3D0
0084             HI2=HP2
0085             IF(IABS(I).LE.10) HI2=HI2*FACA/3D0
0086             NCHN=NCHN+1
0087             ISIG(NCHN,1)=I
0088             ISIG(NCHN,2)=-I
0089             ISIG(NCHN,3)=1
0090             SIGH(NCHN)=FACZP*(EI**2/SH2*HI0*HP0*VINT(111)+EI*VI*
0091      &      (1D0-SQMZ/SH)/((SH-SQMZ)**2+HS**2)*(HI0*HP1+HI1*HP0)*
0092      &      VINT(112)+EI*VPI*(1D0-SQMZP/SH)/((SH-SQMZP)**2+HSP**2)*
0093      &      (HI0*HP2+HI2*HP0)*VINT(113)+(VI**2+AI**2)/
0094      &      ((SH-SQMZ)**2+HS**2)*HI1*HP1*VINT(114)+(VI*VPI+AI*API)*
0095      &      ((SH-SQMZ)*(SH-SQMZP)+HS*HSP)/(((SH-SQMZ)**2+HS**2)*
0096      &      ((SH-SQMZP)**2+HSP**2))*(HI1*HP2+HI2*HP1)*VINT(115)+
0097      &      (VPI**2+API**2)/((SH-SQMZP)**2+HSP**2)*HI2*HP2*VINT(116))
0098   100     CONTINUE
0099
0100         ELSEIF(ISUB.EQ.142) THEN
0101 C...f + fbar' -> W'+/-
0102           SQMWP=PMAS(34,1)**2
0103           CALL PYWIDT(34,SH,WDTP,WDTE)
0104           HS=SHR*WDTP(0)
0105           FACBW=4D0*COMFAC/((SH-SQMWP)**2+HS**2)*3D0
0106           HP=AEM/(24D0*XW)*SH
0107           DO 120 I=MMIN1,MMAX1
0108             IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 120
0109             IA=IABS(I)
0110             DO 110 J=MMIN2,MMAX2
0111               IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 110
0112               JA=IABS(J)
0113               IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 110
0114               IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10))
0115      &        GOTO 110
0116               KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
0117               HI=HP*(PARU(133)**2+PARU(134)**2)
0118               IF(IA.LE.10) HI=HP*(PARU(131)**2+PARU(132)**2)*
0119      &        VCKM((IA+1)/2,(JA+1)/2)*FACA/3D0
0120               NCHN=NCHN+1
0121               ISIG(NCHN,1)=I
0122               ISIG(NCHN,2)=J
0123               ISIG(NCHN,3)=1
0124               HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))
0125               SIGH(NCHN)=HI*FACBW*HF
0126   110       CONTINUE
0127   120     CONTINUE
0128
0129         ELSEIF(ISUB.EQ.144) THEN
0130 C...f + fbar' -> R
0131           SQMR=PMAS(41,1)**2
0132           CALL PYWIDT(41,SH,WDTP,WDTE)
0133           HS=SHR*WDTP(0)
0134           FACBW=4D0*COMFAC/((SH-SQMR)**2+HS**2)*3D0
0135           HP=AEM/(12D0*XW)*SH
0136           DO 140 I=MMIN1,MMAX1
0137             IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 140
0138             IA=IABS(I)
0139             DO 130 J=MMIN2,MMAX2
0140               IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 130
0141               JA=IABS(J)
0142               IF(I*J.GT.0.OR.IABS(IA-JA).NE.2) GOTO 130
0143               HI=HP
0144               IF(IA.LE.10) HI=HI*FACA/3D0
0145               HF=SHR*(WDTE(0,1)+WDTE(0,(10-(I+J))/4)+WDTE(0,4))
0146               NCHN=NCHN+1
0147               ISIG(NCHN,1)=I
0148               ISIG(NCHN,2)=J
0149               ISIG(NCHN,3)=1
0150               SIGH(NCHN)=HI*FACBW*HF
0151   130       CONTINUE
0152   140     CONTINUE
0153
0154         ELSEIF(ISUB.EQ.145) THEN
0155 C...q + l -> LQ (leptoquark)
0156           SQMLQ=PMAS(42,1)**2
0157           CALL PYWIDT(42,SH,WDTP,WDTE)
0158           HS=SHR*WDTP(0)
0159           FACBW=4D0*COMFAC/((SH-SQMLQ)**2+HS**2)
0160           IF(ABS(SHR-PMAS(42,1)).GT.PARP(48)*PMAS(42,2)) FACBW=0D0
0161           HP=AEM/4D0*SH
0162           KFLQQ=KFDP(MDCY(42,2),1)
0163           KFLQL=KFDP(MDCY(42,2),2)
0164           DO 160 I=MMIN1,MMAX1
0165             IF(KFAC(1,I).EQ.0) GOTO 160
0166             IA=IABS(I)
0167             IF(IA.NE.KFLQQ.AND.IA.NE.IABS(KFLQL)) GOTO 160
0168             DO 150 J=MMIN2,MMAX2
0169               IF(KFAC(2,J).EQ.0) GOTO 150
0170               JA=IABS(J)
0171               IF(JA.NE.KFLQQ.AND.JA.NE.IABS(KFLQL)) GOTO 150
0172               IF(I*J.NE.KFLQQ*KFLQL) GOTO 150
0173               IF(JA.EQ.IA) GOTO 150
0174               IF(IA.EQ.KFLQQ) KCHLQ=ISIGN(1,I)
0175               IF(JA.EQ.KFLQQ) KCHLQ=ISIGN(1,J)
0176               HI=HP*PARU(151)
0177               HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHLQ)/2)+WDTE(0,4))
0178               NCHN=NCHN+1
0179               ISIG(NCHN,1)=I
0180               ISIG(NCHN,2)=J
0181               ISIG(NCHN,3)=1
0182               SIGH(NCHN)=HI*FACBW*HF
0183   150       CONTINUE
0184   160     CONTINUE
0185
0186         ELSEIF(ISUB.EQ.146) THEN
0187 C...e + gamma* -> e* (excited lepton)
0188           KFQSTR=KFPR(ISUB,1)
0189           KCQSTR=PYCOMP(KFQSTR)
0190           KFQEXC=MOD(KFQSTR,KEXCIT)
0191           CALL PYWIDT(KFQSTR,SH,WDTP,WDTE)
0192           HS=SHR*WDTP(0)
0193           FACBW=COMFAC/((SH-PMAS(KCQSTR,1)**2)**2+HS**2)
0194           QF=-RTCM(43)/2D0-RTCM(44)/2D0
0195           FACBW=FACBW*AEM*QF**2*SH/RTCM(41)**2
0196           IF(ABS(SHR-PMAS(KCQSTR,1)).GT.PARP(48)*PMAS(KCQSTR,2))
0197      &    FACBW=0D0
0198           HP=SH
0199           DO 180 I=-KFQEXC,KFQEXC,2*KFQEXC
0200             DO 170 ISDE=1,2
0201               IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 170
0202               IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 170
0203               HI=HP
0204               IF(I.GT.0) HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
0205               IF(I.LT.0) HF=SHR*(WDTE(0,1)+WDTE(0,3)+WDTE(0,4))
0206               NCHN=NCHN+1
0207               ISIG(NCHN,ISDE)=I
0208               ISIG(NCHN,3-ISDE)=22
0209               ISIG(NCHN,3)=1
0210               SIGH(NCHN)=HI*FACBW*HF
0211   170       CONTINUE
0212   180     CONTINUE
0213
0214         ELSEIF(ISUB.EQ.147.OR.ISUB.EQ.148) THEN
0215 C...d + g -> d* and u + g -> u* (excited quarks)
0216           KFQSTR=KFPR(ISUB,1)
0217           KCQSTR=PYCOMP(KFQSTR)
0218           KFQEXC=MOD(KFQSTR,KEXCIT)
0219           CALL PYWIDT(KFQSTR,SH,WDTP,WDTE)
0220           HS=SHR*WDTP(0)
0221           FACBW=COMFAC/((SH-PMAS(KCQSTR,1)**2)**2+HS**2)
0222           FACBW=FACBW*AS*RTCM(45)**2*SH/(3D0*RTCM(41)**2)
0223           IF(ABS(SHR-PMAS(KCQSTR,1)).GT.PARP(48)*PMAS(KCQSTR,2))
0224      &    FACBW=0D0
0225           HP=SH
0226           DO 200 I=-KFQEXC,KFQEXC,2*KFQEXC
0227             DO 190 ISDE=1,2
0228               IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 190
0229               IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 190
0230               HI=HP
0231               IF(I.GT.0) HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
0232               IF(I.LT.0) HF=SHR*(WDTE(0,1)+WDTE(0,3)+WDTE(0,4))
0233               NCHN=NCHN+1
0234               ISIG(NCHN,ISDE)=I
0235               ISIG(NCHN,3-ISDE)=21
0236               ISIG(NCHN,3)=1
0237               SIGH(NCHN)=HI*FACBW*HF
0238   190       CONTINUE
0239   200     CONTINUE
0240         ENDIF
0241
0242       ELSEIF(ISUB.LE.190) THEN
0243         IF(ISUB.EQ.162) THEN
0244 C...q + g -> LQ + lbar; LQ=leptoquark
0245           SQMLQ=PMAS(42,1)**2
0246           FACLQ=COMFAC*FACA*PARU(151)*(AS*AEM/6D0)*(-TH/SH)*
0247      &    (UH2+SQMLQ**2)/(UH-SQMLQ)**2
0248           KFLQQ=KFDP(MDCY(42,2),1)
0249           DO 220 I=MMINA,MMAXA
0250             IF(IABS(I).NE.KFLQQ) GOTO 220
0251             KCHLQ=ISIGN(1,I)
0252             DO 210 ISDE=1,2
0253               IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 210
0254               IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 210
0255               NCHN=NCHN+1
0256               ISIG(NCHN,ISDE)=I
0257               ISIG(NCHN,3-ISDE)=21
0258               ISIG(NCHN,3)=1
0259               SIGH(NCHN)=FACLQ*WIDS(42,(5-KCHLQ)/2)
0260   210       CONTINUE
0261   220     CONTINUE
0262
0263         ELSEIF(ISUB.EQ.163) THEN
0264 C...g + g -> LQ + LQbar; LQ=leptoquark
0265           SQMLQ=PMAS(42,1)**2
0266           FACLQ=COMFAC*FACA*WIDS(42,1)*(AS**2/2D0)*
0267      &    (7D0/48D0+3D0*(UH-TH)**2/(16D0*SH2))*(1D0+2D0*SQMLQ*TH/
0268      &    (TH-SQMLQ)**2+2D0*SQMLQ*UH/(UH-SQMLQ)**2+4D0*SQMLQ**2/
0269      &    ((TH-SQMLQ)*(UH-SQMLQ)))
0270           IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 230
0271           NCHN=NCHN+1
0272           ISIG(NCHN,1)=21
0273           ISIG(NCHN,2)=21
0274 C...Since don't know proper colour flow, randomize between alternatives
0275           ISIG(NCHN,3)=INT(1.5D0+PYR(0))
0276           SIGH(NCHN)=FACLQ
0277   230     CONTINUE
0278
0279         ELSEIF(ISUB.EQ.164) THEN
0280 C...q + qbar -> LQ + LQbar; LQ=leptoquark
0281           DELTA=0.25D0*(SQM3-SQM4)**2/SH
0282           SQMLQ=0.5D0*(SQM3+SQM4)-DELTA
0283           TH=TH-DELTA
0284           UH=UH-DELTA
0285 C          SQMLQ=PMAS(42,1)**2
0286           FACLQA=COMFAC*WIDS(42,1)*(AS**2/9D0)*
0287      &    (SH*(SH-4D0*SQMLQ)-(UH-TH)**2)/SH2
0288           FACLQS=COMFAC*WIDS(42,1)*((PARU(151)**2*AEM**2/8D0)*
0289      &    (-SH*TH-(SQMLQ-TH)**2)/TH2+(PARU(151)*AEM*AS/18D0)*
0290      &    ((SQMLQ-TH)*(UH-TH)+SH*(SQMLQ+TH))/(SH*TH))
0291           KFLQQ=KFDP(MDCY(42,2),1)
0292           DO 240 I=MMINA,MMAXA
0293             IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
0294      &      KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 240
0295             NCHN=NCHN+1
0296             ISIG(NCHN,1)=I
0297             ISIG(NCHN,2)=-I
0298             ISIG(NCHN,3)=1
0299             SIGH(NCHN)=FACLQA
0300             IF(IABS(I).EQ.KFLQQ) SIGH(NCHN)=FACLQA+FACLQS
0301   240     CONTINUE
0302
0303         ELSEIF(ISUB.EQ.167.OR.ISUB.EQ.168) THEN
0304 C...q + q' -> q" + d* and q + q' -> q" + u* (excited quarks)
0305           KFQSTR=KFPR(ISUB,2)
0306           KCQSTR=PYCOMP(KFQSTR)
0307           KFQEXC=MOD(KFQSTR,KEXCIT)
0308           FACQSA=COMFAC*(SH/RTCM(41)**2)**2*(1D0-SQM4/SH)
0309           FACQSB=COMFAC*0.25D0*(SH/RTCM(41)**2)**2*(1D0-SQM4/SH)*
0310      &    (1D0+SQM4/SH)*(1D0+CTH)*(1D0+((SH-SQM4)/(SH+SQM4))*CTH)
0311 C...Propagators: as simulated in PYOFSH and as desired
0312           GMMQ=PMAS(KCQSTR,1)*PMAS(KCQSTR,2)
0313           HBW4=GMMQ/((SQM4-PMAS(KCQSTR,1)**2)**2+GMMQ**2)
0314           CALL PYWIDT(KFQSTR,SQM4,WDTP,WDTE)
0315           GMMQC=SQRT(SQM4)*WDTP(0)
0316           HBW4C=GMMQC/((SQM4-PMAS(KCQSTR,1)**2)**2+GMMQC**2)
0317           FACQSA=FACQSA*HBW4C/HBW4
0318           FACQSB=FACQSB*HBW4C/HBW4
0319 C...Branching ratios.
0320           BRPOS=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0)
0321           BRNEG=(WDTE(0,1)+WDTE(0,3)+WDTE(0,4))/WDTP(0)
0322           DO 260 I=MMIN1,MMAX1
0323             IA=IABS(I)
0324             IF(I.EQ.0.OR.IA.GT.6.OR.KFAC(1,I).EQ.0) GOTO 260
0325             DO 250 J=MMIN2,MMAX2
0326               JA=IABS(J)
0327               IF(J.EQ.0.OR.JA.GT.6.OR.KFAC(2,J).EQ.0) GOTO 250
0328               IF(IA.EQ.KFQEXC.AND.I.EQ.J) THEN
0329                 NCHN=NCHN+1
0330                 ISIG(NCHN,1)=I
0331                 ISIG(NCHN,2)=J
0332                 ISIG(NCHN,3)=1
0333                 IF(I.GT.0) SIGH(NCHN)=(4D0/3D0)*FACQSA*BRPOS
0334                 IF(I.LT.0) SIGH(NCHN)=(4D0/3D0)*FACQSA*BRNEG
0335                 NCHN=NCHN+1
0336                 ISIG(NCHN,1)=I
0337                 ISIG(NCHN,2)=J
0338                 ISIG(NCHN,3)=2
0339                 IF(J.GT.0) SIGH(NCHN)=(4D0/3D0)*FACQSA*BRPOS
0340                 IF(J.LT.0) SIGH(NCHN)=(4D0/3D0)*FACQSA*BRNEG
0341               ELSEIF((IA.EQ.KFQEXC.OR.JA.EQ.KFQEXC).AND.I*J.GT.0) THEN
0342                 NCHN=NCHN+1
0343                 ISIG(NCHN,1)=I
0344                 ISIG(NCHN,2)=J
0345                 ISIG(NCHN,3)=1
0346                 IF(JA.EQ.KFQEXC) ISIG(NCHN,3)=2
0347                 IF(ISIG(NCHN,ISIG(NCHN,3)).GT.0) SIGH(NCHN)=FACQSA*BRPOS
0348                 IF(ISIG(NCHN,ISIG(NCHN,3)).LT.0) SIGH(NCHN)=FACQSA*BRNEG
0349               ELSEIF(IA.EQ.KFQEXC.AND.I.EQ.-J) THEN
0350                 NCHN=NCHN+1
0351                 ISIG(NCHN,1)=I
0352                 ISIG(NCHN,2)=J
0353                 ISIG(NCHN,3)=1
0354                 IF(I.GT.0) SIGH(NCHN)=(8D0/3D0)*FACQSB*BRPOS
0355                 IF(I.LT.0) SIGH(NCHN)=(8D0/3D0)*FACQSB*BRNEG
0356                 NCHN=NCHN+1
0357                 ISIG(NCHN,1)=I
0358                 ISIG(NCHN,2)=J
0359                 ISIG(NCHN,3)=2
0360                 IF(J.GT.0) SIGH(NCHN)=(8D0/3D0)*FACQSB*BRPOS
0361                 IF(J.LT.0) SIGH(NCHN)=(8D0/3D0)*FACQSB*BRNEG
0362               ELSEIF(I.EQ.-J) THEN
0363                 NCHN=NCHN+1
0364                 ISIG(NCHN,1)=I
0365                 ISIG(NCHN,2)=J
0366                 ISIG(NCHN,3)=1
0367                 IF(I.GT.0) SIGH(NCHN)=FACQSB*BRPOS
0368                 IF(I.LT.0) SIGH(NCHN)=FACQSB*BRNEG
0369                 NCHN=NCHN+1
0370                 ISIG(NCHN,1)=I
0371                 ISIG(NCHN,2)=J
0372                 ISIG(NCHN,3)=2
0373                 IF(J.GT.0) SIGH(NCHN)=FACQSB*BRPOS
0374                 IF(J.LT.0) SIGH(NCHN)=FACQSB*BRNEG
0375               ELSEIF(IA.EQ.KFQEXC.OR.JA.EQ.KFQEXC) THEN
0376                 NCHN=NCHN+1
0377                 ISIG(NCHN,1)=I
0378                 ISIG(NCHN,2)=J
0379                 ISIG(NCHN,3)=1
0380                 IF(JA.EQ.KFQEXC) ISIG(NCHN,3)=2
0381                 IF(ISIG(NCHN,ISIG(NCHN,3)).GT.0) SIGH(NCHN)=FACQSB*BRPOS
0382                 IF(ISIG(NCHN,ISIG(NCHN,3)).LT.0) SIGH(NCHN)=FACQSB*BRNEG
0383               ENDIF
0384   250       CONTINUE
0385   260     CONTINUE
0386
0387         ELSEIF(ISUB.EQ.169) THEN
0388 C...q + qbar -> e + e* (excited lepton)
0389           KFQSTR=KFPR(ISUB,2)
0390           KCQSTR=PYCOMP(KFQSTR)
0391           KFQEXC=MOD(KFQSTR,KEXCIT)
0392           FACQSB=(COMFAC/12D0)*(SH/RTCM(41)**2)**2*(1D0-SQM4/SH)*
0393      &    (1D0+SQM4/SH)*(1D0+CTH)*(1D0+((SH-SQM4)/(SH+SQM4))*CTH)
0394 C...Propagators: as simulated in PYOFSH and as desired
0395           GMMQ=PMAS(KCQSTR,1)*PMAS(KCQSTR,2)
0396           HBW4=GMMQ/((SQM4-PMAS(KCQSTR,1)**2)**2+GMMQ**2)
0397           CALL PYWIDT(KFQSTR,SQM4,WDTP,WDTE)
0398           GMMQC=SQRT(SQM4)*WDTP(0)
0399           HBW4C=GMMQC/((SQM4-PMAS(KCQSTR,1)**2)**2+GMMQC**2)
0400           FACQSB=FACQSB*HBW4C/HBW4
0401 C...Branching ratios.
0402           BRPOS=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0)
0403           BRNEG=(WDTE(0,1)+WDTE(0,3)+WDTE(0,4))/WDTP(0)
0404           DO 270 I=MMIN1,MMAX1
0405             IA=IABS(I)
0406             IF(I.EQ.0.OR.IA.GT.6.OR.KFAC(1,I).EQ.0) GOTO 270
0407             J=-I
0408             JA=IABS(J)
0409             IF(J.EQ.0.OR.JA.GT.6.OR.KFAC(2,J).EQ.0) GOTO 270
0410             NCHN=NCHN+1
0411             ISIG(NCHN,1)=I
0412             ISIG(NCHN,2)=J
0413             ISIG(NCHN,3)=1
0414             IF(I.GT.0) SIGH(NCHN)=FACQSB*BRPOS
0415             IF(I.LT.0) SIGH(NCHN)=FACQSB*BRNEG
0416             NCHN=NCHN+1
0417             ISIG(NCHN,1)=I
0418             ISIG(NCHN,2)=J
0419             ISIG(NCHN,3)=2
0420             IF(J.GT.0) SIGH(NCHN)=FACQSB*BRPOS
0421             IF(J.LT.0) SIGH(NCHN)=FACQSB*BRNEG
0422   270     CONTINUE
0423         ENDIF
0424
0425       ELSEIF(ISUB.LE.360) THEN
0426         IF(ISUB.EQ.341.OR.ISUB.EQ.342) THEN
0427 C...l + l -> H_L++/-- or H_R++/--.
0428           KFRES=KFPR(ISUB,1)
0429           KFREC=PYCOMP(KFRES)
0430           CALL PYWIDT(KFRES,SH,WDTP,WDTE)
0431           HS=SHR*WDTP(0)
0432           FACBW=8D0*COMFAC/((SH-PMAS(KFREC,1)**2)**2+HS**2)
0433           DO 290 I=MMIN1,MMAX1
0434             IA=IABS(I)
0435             IF((IA.NE.11.AND.IA.NE.13.AND.IA.NE.15).OR.KFAC(1,I).EQ.0)
0436      &      GOTO 290
0437             DO 280 J=MMIN2,MMAX2
0438               JA=IABS(J)
0439               IF((JA.NE.11.AND.JA.NE.13.AND.JA.NE.15).OR.KFAC(2,J).EQ.0)
0440      &        GOTO 280
0441               IF(I*J.LT.0) GOTO 280
0442               KCHH=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
0443               NCHN=NCHN+1
0444               ISIG(NCHN,1)=I
0445               ISIG(NCHN,2)=J
0446               ISIG(NCHN,3)=1
0447               HI=SH*PARP(181+3*((IA-11)/2)+(JA-11)/2)**2/(8D0*PARU(1))
0448               HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHH/2)/2)+WDTE(0,4))
0449               SIGH(NCHN)=HI*FACBW*HF
0450   280       CONTINUE
0451   290     CONTINUE
0452
0453         ELSEIF(ISUB.GE.343.AND.ISUB.LE.348) THEN
0454 C...l + gamma -> H_L++/-- l' or l + gamma -> H_R++/-- l'.
0455           KFRES=KFPR(ISUB,1)
0456           KFREC=PYCOMP(KFRES)
0457 C...Propagators: as simulated in PYOFSH and as desired
0458           HBW3=PMAS(KFREC,1)*PMAS(KFREC,2)/((SQM3-PMAS(KFREC,1)**2)**2+
0459      &    (PMAS(KFREC,1)*PMAS(KFREC,2))**2)
0460           CALL PYWIDT(KFRES,SQM3,WDTP,WDTE)
0461           GMMC=SQRT(SQM3)*WDTP(0)
0462           HBW3C=GMMC/((SQM3-PMAS(KFREC,1)**2)**2+GMMC**2)
0463           FHCC=COMFAC*AEM*HBW3C/HBW3
0464           DO 310 I=MMINA,MMAXA
0465             IA=IABS(I)
0466             IF(IA.NE.11.AND.IA.NE.13.AND.IA.NE.15) GOTO 310
0467             SQML=PMAS(IA,1)**2
0468             J=ISIGN(KFPR(ISUB,2),-I)
0469             KCHH=ISIGN(2,KCHG(IA,1)*ISIGN(1,I))
0470             WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHH/2)/2)+WDTE(0,4))/WDTP(0)
0471             SMM1=8D0*(SH+TH-SQM3)*(SH+TH-2D0*SQM3-SQML-SQM4)/
0472      &      (UH-SQM3)**2
0473             SMM2=2D0*((2D0*SQM3-3D0*SQML)*SQM4+(SQML-2D0*SQM4)*TH-
0474      &      (TH-SQM4)*SH)/(TH-SQM4)**2
0475             SMM3=2D0*((2D0*SQM3-3D0*SQM4+TH)*SQML-(2D0*SQML-SQM4+TH)*
0476      &      SH)/(SH-SQML)**2
0477             SMM12=4D0*((2D0*SQML-SQM4-2D0*SQM3+TH)*SH+(TH-3D0*SQM3-
0478      &      3D0*SQM4)*TH+(2D0*SQM3-2D0*SQML+3D0*SQM4)*SQM3)/
0479      &      ((UH-SQM3)*(TH-SQM4))
0480             SMM13=-4D0*((TH+SQML-2D0*SQM4)*TH-(SQM3+3D0*SQML-2D0*SQM4)*
0481      &      SQM3+(SQM3+3D0*SQML+TH)*SH-(TH-SQM3+SH)**2)/
0482      &      ((UH-SQM3)*(SH-SQML))
0483             SMM23=-4D0*((SQML-SQM4+SQM3)*TH-SQM3**2+SQM3*(SQML+SQM4)-
0484      &      3D0*SQML*SQM4-(SQML-SQM4-SQM3+TH)*SH)/
0485      &      ((SH-SQML)*(TH-SQM4))
0486             SMM=(SH/(SH-SQML))**2*(SMM1+SMM2+SMM3+SMM12+SMM13+SMM23)*
0487      &      PARP(181+3*((IA-11)/2)+(IABS(J)-11)/2)**2/(4D0*PARU(1))
0488             DO 300 ISDE=1,2
0489               IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 300
0490               IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 300
0491               NCHN=NCHN+1
0492               ISIG(NCHN,ISDE)=I
0493               ISIG(NCHN,3-ISDE)=22
0494               ISIG(NCHN,3)=0
0495               SIGH(NCHN)=FHCC*SMM*WIDSC
0496   300       CONTINUE
0497   310     CONTINUE
0498
0499         ELSEIF(ISUB.EQ.349.OR.ISUB.EQ.350) THEN
0500 C...f + fbar -> H_L++ + H_L-- or H_R++ + H_R--
0501           KFRES=KFPR(ISUB,1)
0502           KFREC=PYCOMP(KFRES)
0503           SQMH=PMAS(KFREC,1)**2
0504           GMMH=PMAS(KFREC,1)*PMAS(KFREC,2)
0505 C...Propagators: H++/-- as simulated in PYOFSH and as desired
0506           HBW3=GMMH/((SQM3-SQMH)**2+GMMH**2)
0507           CALL PYWIDT(KFRES,SQM3,WDTP,WDTE)
0508           GMMH3=SQRT(SQM3)*WDTP(0)
0509           HBW3C=GMMH3/((SQM3-SQMH)**2+GMMH3**2)
0510           HBW4=GMMH/((SQM4-SQMH)**2+GMMH**2)
0511           CALL PYWIDT(KFRES,SQM4,WDTP,WDTE)
0512           GMMH4=SQRT(SQM4)*WDTP(0)
0513           HBW4C=GMMH4/((SQM4-SQMH)**2+GMMH4**2)
0514 C...Kinematical and coupling functions
0515           FACHH=COMFAC*(HBW3C/HBW3)*(HBW4C/HBW4)*(TH*UH-SQM3*SQM4)
0516           XWHH=(1D0-2D0*XWV)/(8D0*XWV*(1D0-XWV))
0517 C...Loop over allowed flavours
0518           DO 320 I=MMINA,MMAXA
0519             IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 320
0520             EI=KCHG(IABS(I),1)/3D0
0521             AI=SIGN(1D0,EI+0.1D0)
0522             VI=AI-4D0*EI*XWV
0523             FCOI=1D0
0524             IF(IABS(I).LE.10) FCOI=FACA/3D0
0525             IF(ISUB.EQ.349) THEN
0526               HBWZ=1D0/((SH-SQMZ)**2+GMMZ**2)
0527               IF(IABS(I).LT.10) THEN
0528                 DSIGHH=8D0*AEM**2*(EI**2/SH2+
0529      &          2D0*EI*VI*XWHH*(SH-SQMZ)*HBWZ/SH+
0530      &          (VI**2+AI**2)*XWHH**2*HBWZ)
0531               ELSE
0532                 IAOFF=181+3*((IABS(I)-11)/2)
0533                 HSUM=(PARP(IAOFF)**2+PARP(IAOFF+1)**2+PARP(IAOFF+2)**2)/
0534      &          (4D0*PARU(1))
0535                 DSIGHH=8D0*AEM**2*(EI**2/SH2+
0536      &          2D0*EI*VI*XWHH*(SH-SQMZ)*HBWZ/SH+
0537      &          (VI**2+AI**2)*XWHH**2*HBWZ)+
0538      &          8D0*AEM*(EI*HSUM/(SH*TH)+
0539      &          (VI+AI)*XWHH*HSUM*(SH-SQMZ)*HBWZ/TH)+
0540      &          4D0*HSUM**2/TH2
0541               ENDIF
0542             ELSE
0543               IF(IABS(I).LT.10) THEN
0544                 DSIGHH=8D0*AEM**2*EI**2/SH2
0545               ELSE
0546                 IAOFF=181+3*((IABS(I)-11)/2)
0547                 HSUM=(PARP(IAOFF)**2+PARP(IAOFF+1)**2+PARP(IAOFF+2)**2)/
0548      &          (4D0*PARU(1))
0549                 DSIGHH=8D0*AEM**2*EI**2/SH2+8D0*AEM*EI*HSUM/(SH*TH)+
0550      &          4D0*HSUM**2/TH2
0551               ENDIF
0552             ENDIF
0553             NCHN=NCHN+1
0554             ISIG(NCHN,1)=I
0555             ISIG(NCHN,2)=-I
0556             ISIG(NCHN,3)=1
0557             SIGH(NCHN)=FACHH*FCOI*DSIGHH
0558   320     CONTINUE
0559
0560         ELSEIF(ISUB.EQ.351.OR.ISUB.EQ.352) THEN
0561 C...f + f' -> f" + f"' + H++/-- (W+/- + W+/- -> H++/-- as inner process)
0562           KFRES=KFPR(ISUB,1)
0563           KFREC=PYCOMP(KFRES)
0564           SQMH=PMAS(KFREC,1)**2
0565           IF(ISUB.EQ.351) FACNOR=PARP(190)**8*PARP(192)**2
0566           IF(ISUB.EQ.352) FACNOR=PARP(191)**6*2D0*
0567      &    PMAS(PYCOMP(9900024),1)**2
0568           FACWW=COMFAC*FACNOR*TAUP*VINT(2)*VINT(219)
0569           FACPRT=1D0/((VINT(204)**2-VINT(215))*
0570      &    (VINT(209)**2-VINT(216)))
0571           FACPRU=1D0/((VINT(204)**2+2D0*VINT(217))*
0572      &    (VINT(209)**2+2D0*VINT(218)))
0573           CALL PYWIDT(KFRES,SH,WDTP,WDTE)
0574           HS=SHR*WDTP(0)
0575           FACBW=(1D0/PARU(1))*VINT(2)/((SH-SQMH)**2+HS**2)
0576           IF(ABS(SHR-PMAS(KFREC,1)).GT.PARP(48)*PMAS(KFREC,2))
0577      &    FACBW=0D0
0578           DO 340 I=MMIN1,MMAX1
0579             IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 340
0580             IF(ISUB.EQ.352.AND.IABS(I).GT.10) GOTO 340
0581             KCHWI=(1-2*MOD(IABS(I),2))*ISIGN(1,I)
0582             DO 330 J=MMIN2,MMAX2
0583               IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 330
0584               IF(ISUB.EQ.352.AND.IABS(J).GT.10) GOTO 330
0585               KCHWJ=(1-2*MOD(IABS(J),2))*ISIGN(1,J)
0586               KCHH=KCHWI+KCHWJ
0587               IF(IABS(KCHH).NE.2) GOTO 330
0588               FACLR=VINT(180+I)*VINT(180+J)
0589               HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHH/2)/2)+WDTE(0,4))
0590               IF(I.EQ.J.AND.IABS(I).GT.10) THEN
0591                 FACPRP=0.5D0*(FACPRT+FACPRU)**2
0592               ELSE
0593                 FACPRP=FACPRT**2
0594               ENDIF
0595               NCHN=NCHN+1
0596               ISIG(NCHN,1)=I
0597               ISIG(NCHN,2)=J
0598               ISIG(NCHN,3)=1
0599               SIGH(NCHN)=FACLR*FACWW*FACPRP*FACBW*HF
0600   330       CONTINUE
0601   340     CONTINUE
0602
0603         ELSEIF(ISUB.EQ.353) THEN
0604 C...f + fbar -> Z_R0
0605           SQMZR=PMAS(PYCOMP(KFPR(ISUB,1)),1)**2
0606           CALL PYWIDT(KFPR(ISUB,1),SH,WDTP,WDTE)
0607           HS=SHR*WDTP(0)
0608           FACBW=4D0*COMFAC/((SH-SQMZR)**2+HS**2)*3D0
0609           HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
0610           HP=(AEM/(3D0*(1D0-2D0*XW)))*XWC*SH
0611           DO 350 I=MMINA,MMAXA
0612             IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 350
0613             IF(IABS(I).LE.8) THEN
0614               EI=KCHG(IABS(I),1)/3D0
0615               AI=SIGN(1D0,EI+0.1D0)*(1D0-2D0*XW)
0616               VI=SIGN(1D0,EI+0.1D0)-4D0*EI*XW
0617             ELSE
0618               AI=-(1D0-2D0*XW)
0619               VI=-1D0+4D0*XW
0620             ENDIF
0621             HI=HP*(VI**2+AI**2)
0622             IF(IABS(I).LE.10) HI=HI*FACA/3D0
0623             NCHN=NCHN+1
0624             ISIG(NCHN,1)=I
0625             ISIG(NCHN,2)=-I
0626             ISIG(NCHN,3)=1
0627             SIGH(NCHN)=HI*FACBW*HF
0628   350     CONTINUE
0629
0630         ELSEIF(ISUB.EQ.354) THEN
0631 C...f + fbar' -> W_R+/-
0632           SQMWR=PMAS(PYCOMP(KFPR(ISUB,1)),1)**2
0633           CALL PYWIDT(KFPR(ISUB,1),SH,WDTP,WDTE)
0634           HS=SHR*WDTP(0)
0635           FACBW=4D0*COMFAC/((SH-SQMWR)**2+HS**2)*3D0
0636           HP=AEM/(24D0*XW)*SH
0637           DO 370 I=MMIN1,MMAX1
0638             IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 370
0639             IA=IABS(I)
0640             DO 360 J=MMIN2,MMAX2
0641               IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 360
0642               JA=IABS(J)
0643               IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 360
0644               IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10))
0645      &        GOTO 360
0646               KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
0647               HI=HP*2D0
0648               IF(IA.LE.10) HI=HI*VCKM((IA+1)/2,(JA+1)/2)*FACA/3D0
0649               NCHN=NCHN+1
0650               ISIG(NCHN,1)=I
0651               ISIG(NCHN,2)=J
0652               ISIG(NCHN,3)=1
0653               HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))
0654               SIGH(NCHN)=HI*FACBW*HF
0655   360       CONTINUE
0656   370     CONTINUE
0657         ENDIF
0658
0659       ELSEIF(ISUB.LE.400) THEN
0660         IF(ISUB.EQ.391) THEN
0661 C...f + fbar -> G*.
0662           KFGSTR=KFPR(ISUB,1)
0663           KCGSTR=PYCOMP(KFGSTR)
0664           CALL PYWIDT(KFGSTR,SH,WDTP,WDTE)
0665           HS=SHR*WDTP(0)
0666           HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
0667           FACG=COMFAC*PARP(50)**2/(16D0*PARU(1))*SH*HF/
0668      &    ((SH-PMAS(KCGSTR,1)**2)**2+HS**2)
0669 C...Modify cross section in wings of peak.
0670           FACG = FACG * SH**2 / PMAS(KCGSTR,1)**4
0671           DO 380 I=MMINA,MMAXA
0672             IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 380
0673             HI=1D0
0674             IF(IABS(I).LE.10) HI=HI*FACA/3D0
0675             NCHN=NCHN+1
0676             ISIG(NCHN,1)=I
0677             ISIG(NCHN,2)=-I
0678             ISIG(NCHN,3)=1
0679             SIGH(NCHN)=FACG*HI
0680   380     CONTINUE
0681
0682         ELSEIF(ISUB.EQ.392) THEN
0683 C...g + g -> G*.
0684           KFGSTR=KFPR(ISUB,1)
0685           KCGSTR=PYCOMP(KFGSTR)
0686           CALL PYWIDT(KFGSTR,SH,WDTP,WDTE)
0687           HS=SHR*WDTP(0)
0688           HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
0689           FACG=COMFAC*PARP(50)**2/(32D0*PARU(1))*SH*HF/
0690      &    ((SH-PMAS(KCGSTR,1)**2)**2+HS**2)
0691 C...Modify cross section in wings of peak.
0692           FACG = FACG * SH**2 / PMAS(KCGSTR,1)**4
0693           IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 390
0694           NCHN=NCHN+1
0695           ISIG(NCHN,1)=21
0696           ISIG(NCHN,2)=21
0697           ISIG(NCHN,3)=1
0698           SIGH(NCHN)=FACG
0699   390     CONTINUE
0700
0701         ELSEIF(ISUB.EQ.393) THEN
0702 C...q + qbar -> g + G*.
0703           KFGSTR=KFPR(ISUB,2)
0704           KCGSTR=PYCOMP(KFGSTR)
0705           FACG=COMFAC*PARP(50)**2*AS*SH/(72D0*PARU(1)*SQM4)*
0706      &    (4D0*(TH2+UH2)/SH2+9D0*(TH+UH)/SH+(TH2/UH+UH2/TH)/SH+
0707      &    3D0*(4D0+TH/UH+UH/TH)+4D0*(SH/UH+SH/TH)+
0708      &    2D0*SH2/(TH*UH))
0709 C...Propagators: as simulated in PYOFSH and as desired
0710           GMMG=PMAS(KCGSTR,1)*PMAS(KCGSTR,2)
0711           HBW4=GMMG/((SQM4-PMAS(KCGSTR,1)**2)**2+GMMG**2)
0712           CALL PYWIDT(KFGSTR,SQM4,WDTP,WDTE)
0713           HS=SQRT(SQM4)*WDTP(0)
0714           HF=SQRT(SQM4)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
0715           HBW4C=HF/((SQM4-PMAS(KCGSTR,1)**2)**2+HS**2)
0716           FACG=FACG*HBW4C/HBW4
0717           DO 400 I=MMINA,MMAXA
0718             IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
0719      &      KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 400
0720             NCHN=NCHN+1
0721             ISIG(NCHN,1)=I
0722             ISIG(NCHN,2)=-I
0723             ISIG(NCHN,3)=1
0724             SIGH(NCHN)=FACG
0725   400     CONTINUE
0726
0727         ELSEIF(ISUB.EQ.394) THEN
0728 C...q + g -> q + G*.
0729           KFGSTR=KFPR(ISUB,2)
0730           KCGSTR=PYCOMP(KFGSTR)
0731           FACG=-COMFAC*PARP(50)**2*AS*SH/(192D0*PARU(1)*SQM4)*
0732      &    (4D0*(SH2+UH2)/(TH*SH)+9D0*(SH+UH)/SH+SH/UH+UH2/SH2+
0733      &    3D0*TH*(4D0+SH/UH+UH/SH)/SH+4D0*TH2*(1D0/UH+1D0/SH)/SH+
0734      &    2D0*TH2*TH/(UH*SH2))
0735 C...Propagators: as simulated in PYOFSH and as desired
0736           GMMG=PMAS(KCGSTR,1)*PMAS(KCGSTR,2)
0737           HBW4=GMMG/((SQM4-PMAS(KCGSTR,1)**2)**2+GMMG**2)
0738           CALL PYWIDT(KFGSTR,SQM4,WDTP,WDTE)
0739           HS=SQRT(SQM4)*WDTP(0)
0740           HF=SQRT(SQM4)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
0741           HBW4C=HF/((SQM4-PMAS(KCGSTR,1)**2)**2+HS**2)
0742           FACG=FACG*HBW4C/HBW4
0743           DO 420 I=MMINA,MMAXA
0744             IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 420
0745             DO 410 ISDE=1,2
0746               IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 410
0747               IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 410
0748               NCHN=NCHN+1
0749               ISIG(NCHN,ISDE)=I
0750               ISIG(NCHN,3-ISDE)=21
0751               ISIG(NCHN,3)=1
0752               SIGH(NCHN)=FACG
0753   410       CONTINUE
0754   420     CONTINUE
0755
0756         ELSEIF(ISUB.EQ.395) THEN
0757 C...g + g -> g + G*.
0758           KFGSTR=KFPR(ISUB,2)
0759           KCGSTR=PYCOMP(KFGSTR)
0760           FACG=COMFAC*3D0*PARP(50)**2*AS*SH/(32D0*PARU(1)*SQM4)*
0761      &    ((TH2+TH*UH+UH2)**2/(SH2*TH*UH)+2D0*(TH2/UH+UH2/TH)/SH+
0762      &    3D0*(TH/UH+UH/TH)+2D0*(SH/UH+SH/TH)+SH2/(TH*UH))
0763 C...Propagators: as simulated in PYOFSH and as desired
0764           GMMG=PMAS(KCGSTR,1)*PMAS(KCGSTR,2)
0765           HBW4=GMMG/((SQM4-PMAS(KCGSTR,1)**2)**2+GMMG**2)
0766           CALL PYWIDT(KFGSTR,SQM4,WDTP,WDTE)
0767           HS=SQRT(SQM4)*WDTP(0)
0768           HF=SQRT(SQM4)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
0769           HBW4C=HF/((SQM4-PMAS(KCGSTR,1)**2)**2+HS**2)
0770           FACG=FACG*HBW4C/HBW4
0771           IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN
0772             NCHN=NCHN+1
0773             ISIG(NCHN,1)=21
0774             ISIG(NCHN,2)=21
0775             ISIG(NCHN,3)=1
0776             SIGH(NCHN)=FACG
0777           ENDIF
0778         ENDIF
0779       ENDIF
0780
0781       RETURN
0782       END