pythiaeRHIC/pythia/pysgwz.f

0001
0002 C*********************************************************************
0003
0004 C...PYSGWZ
0005 C...Subprocess cross sections for W/Z processes,
0006 C...except that longitudinal WW scattering is in Higgs sector.
0007 C...Auxiliary to PYSIGH.
0008
0009       SUBROUTINE PYSGWZ(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/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200)
0023       COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
0024       COMMON/PYINT1/MINT(400),VINT(400)
0025       COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2)
0026       COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000)
0027       COMMON/PYINT4/MWID(500),WIDS(500,5)
0028       COMMON/PYTCSM/ITCM(0:99),RTCM(0:99)
0029       COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA,
0030      &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4,
0031      &SHR,SQPTH,TAUP,BE34,CTH,X(2),SQMZ,SQMW,GMMZ,GMMW,
0032      &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR
0033       SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/,
0034      &/PYINT2/,/PYINT3/,/PYINT4/,/PYTCSM/,/PYSGCM/
0035 C...Local arrays and complex numbers
0036       DIMENSION WDTP(0:400),WDTE(0:400,0:5),HGZ(6,3),HL3(3),HR3(3),
0037      &HL4(3),HR4(3)
0038       COMPLEX*16 COULCK,COULCP,COULCD,COULCR,COULCS
0039
0040 C...Differential cross section expressions.
0041
0042       IF(ISUB.LE.20) THEN
0043         IF(ISUB.EQ.1) THEN
0044 C...f + fbar -> gamma*/Z0
0045           MINT(61)=2
0046           CALL PYWIDT(23,SH,WDTP,WDTE)
0047           HS=SHR*WDTP(0)
0048           FACZ=4D0*COMFAC*3D0
0049           HP0=AEM/3D0*SH
0050           HP1=AEM/3D0*XWC*SH
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             HI0=HP0
0057             IF(IABS(I).LE.10) HI0=HI0*FACA/3D0
0058             HI1=HP1
0059             IF(IABS(I).LE.10) HI1=HI1*FACA/3D0
0060             NCHN=NCHN+1
0061             ISIG(NCHN,1)=I
0062             ISIG(NCHN,2)=-I
0063             ISIG(NCHN,3)=1
0064             SIGH(NCHN)=FACZ*(EI**2/SH2*HI0*HP0*VINT(111)+
0065      &      EI*VI*(1D0-SQMZ/SH)/((SH-SQMZ)**2+HS**2)*
0066      &      (HI0*HP1+HI1*HP0)*VINT(112)+(VI**2+AI**2)/
0067      &      ((SH-SQMZ)**2+HS**2)*HI1*HP1*VINT(114))
0068   100     CONTINUE
0069
0070         ELSEIF(ISUB.EQ.2) THEN
0071 C...f + fbar' -> W+/-
0072           CALL PYWIDT(24,SH,WDTP,WDTE)
0073           HS=SHR*WDTP(0)
0074           FACBW=4D0*COMFAC/((SH-SQMW)**2+HS**2)*3D0
0075           HP=AEM/(24D0*XW)*SH
0076           DO 120 I=MMIN1,MMAX1
0077             IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 120
0078             IA=IABS(I)
0079             DO 110 J=MMIN2,MMAX2
0080               IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 110
0081               JA=IABS(J)
0082               IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 110
0083               IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10))
0084      &        GOTO 110
0085               KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
0086               HI=HP*2D0
0087               IF(IA.LE.10) HI=HI*VCKM((IA+1)/2,(JA+1)/2)*FACA/3D0
0088               NCHN=NCHN+1
0089               ISIG(NCHN,1)=I
0090               ISIG(NCHN,2)=J
0091               ISIG(NCHN,3)=1
0092               HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))
0093               SIGH(NCHN)=HI*FACBW*HF
0094   110       CONTINUE
0095   120     CONTINUE
0096
0097         ELSEIF(ISUB.EQ.15) THEN
0098 C...f + fbar -> g + (gamma*/Z0) (q + qbar -> g + (gamma*/Z0) only)
0099           FACZG=COMFAC*AS*AEM*(8D0/9D0)*(TH2+UH2+2D0*SQM4*SH)/(TH*UH)
0100 C...gamma, gamma/Z interference and Z couplings to final fermion pairs
0101           HFGG=0D0
0102           HFGZ=0D0
0103           HFZZ=0D0
0104           RADC4=1D0+PYALPS(SQM4)/PARU(1)
0105           DO 130 I=1,MIN(16,MDCY(23,3))
0106             IDC=I+MDCY(23,2)-1
0107             IF(MDME(IDC,1).LT.0) GOTO 130
0108             IMDM=0
0109             IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2.OR.MDME(IDC,1).EQ.4)
0110      &      IMDM=1
0111             IF(I.LE.8) THEN
0112               EF=KCHG(I,1)/3D0
0113               AF=SIGN(1D0,EF+0.1D0)
0114               VF=AF-4D0*EF*XWV
0115             ELSEIF(I.LE.16) THEN
0116               EF=KCHG(I+2,1)/3D0
0117               AF=SIGN(1D0,EF+0.1D0)
0118               VF=AF-4D0*EF*XWV
0119             ENDIF
0120             RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4
0121             IF(4D0*RM1.LT.1D0) THEN
0122               FCOF=1D0
0123               IF(I.LE.8) FCOF=3D0*RADC4
0124               BE34=SQRT(MAX(0D0,1D0-4D0*RM1))
0125               IF(IMDM.EQ.1) THEN
0126                 HFGG=HFGG+FCOF*EF**2*(1D0+2D0*RM1)*BE34
0127                 HFGZ=HFGZ+FCOF*EF*VF*(1D0+2D0*RM1)*BE34
0128                 HFZZ=HFZZ+FCOF*(VF**2*(1D0+2D0*RM1)+
0129      &          AF**2*(1D0-4D0*RM1))*BE34
0130               ENDIF
0131             ENDIF
0132   130     CONTINUE
0133 C...Propagators: as simulated in PYOFSH and as desired
0134           HBW4=(1D0/PARU(1))*GMMZ/((SQM4-SQMZ)**2+GMMZ**2)
0135           MINT15=MINT(15)
0136           MINT(15)=1
0137           MINT(61)=1
0138           CALL PYWIDT(23,SQM4,WDTP,WDTE)
0139           MINT(15)=MINT15
0140           HFAEM=(PARU(108)/PARU(2))*(2D0/3D0)
0141           HFGG=HFGG*HFAEM*VINT(111)/SQM4
0142           HFGZ=HFGZ*HFAEM*VINT(112)/SQM4
0143           HFZZ=HFZZ*HFAEM*VINT(114)/SQM4
0144 C...Loop over flavours; consider full gamma/Z structure
0145           DO 140 I=MMINA,MMAXA
0146             IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
0147      &      KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 140
0148             EI=KCHG(IABS(I),1)/3D0
0149             AI=SIGN(1D0,EI)
0150             VI=AI-4D0*EI*XWV
0151             NCHN=NCHN+1
0152             ISIG(NCHN,1)=I
0153             ISIG(NCHN,2)=-I
0154             ISIG(NCHN,3)=1
0155             SIGH(NCHN)=FACZG*(EI**2*HFGG+EI*VI*HFGZ+
0156      &      (VI**2+AI**2)*HFZZ)/HBW4
0157   140     CONTINUE
0158
0159         ELSEIF(ISUB.EQ.16) THEN
0160 C...f + fbar' -> g + W+/- (q + qbar' -> g + W+/- only)
0161           FACWG=COMFAC*AS*AEM/XW*2D0/9D0*(TH2+UH2+2D0*SQM4*SH)/(TH*UH)
0162 C...Propagators: as simulated in PYOFSH and as desired
0163           HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2)
0164           CALL PYWIDT(24,SQM4,WDTP,WDTE)
0165           GMMWC=SQRT(SQM4)*WDTP(0)
0166           HBW4C=GMMWC/((SQM4-SQMW)**2+GMMWC**2)
0167           FACWG=FACWG*HBW4C/HBW4
0168           DO 160 I=MMIN1,MMAX1
0169             IA=IABS(I)
0170             IF(I.EQ.0.OR.IA.GT.10.OR.KFAC(1,I).EQ.0) GOTO 160
0171             DO 150 J=MMIN2,MMAX2
0172               JA=IABS(J)
0173               IF(J.EQ.0.OR.JA.GT.10.OR.KFAC(2,J).EQ.0) GOTO 150
0174               IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 150
0175               KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
0176               WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))/WDTP(0)
0177               FCKM=VCKM((IA+1)/2,(JA+1)/2)
0178               NCHN=NCHN+1
0179               ISIG(NCHN,1)=I
0180               ISIG(NCHN,2)=J
0181               ISIG(NCHN,3)=1
0182               SIGH(NCHN)=FACWG*FCKM*WIDSC
0183   150       CONTINUE
0184   160     CONTINUE
0185
0186         ELSEIF(ISUB.EQ.19) THEN
0187 C...f + fbar -> gamma + (gamma*/Z0)
0188           FACGZ=COMFAC*2D0*AEM**2*(TH2+UH2+2D0*SQM4*SH)/(TH*UH)
0189 C...gamma, gamma/Z interference and Z couplings to final fermion pairs
0190           HFGG=0D0
0191           HFGZ=0D0
0192           HFZZ=0D0
0193           RADC4=1D0+PYALPS(SQM4)/PARU(1)
0194           DO 170 I=1,MIN(16,MDCY(23,3))
0195             IDC=I+MDCY(23,2)-1
0196             IF(MDME(IDC,1).LT.0) GOTO 170
0197             IMDM=0
0198             IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2.OR.MDME(IDC,1).EQ.4)
0199      &      IMDM=1
0200             IF(I.LE.8) THEN
0201               EF=KCHG(I,1)/3D0
0202               AF=SIGN(1D0,EF+0.1D0)
0203               VF=AF-4D0*EF*XWV
0204             ELSEIF(I.LE.16) THEN
0205               EF=KCHG(I+2,1)/3D0
0206               AF=SIGN(1D0,EF+0.1D0)
0207               VF=AF-4D0*EF*XWV
0208             ENDIF
0209             RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4
0210             IF(4D0*RM1.LT.1D0) THEN
0211               FCOF=1D0
0212               IF(I.LE.8) FCOF=3D0*RADC4
0213               BE34=SQRT(MAX(0D0,1D0-4D0*RM1))
0214               IF(IMDM.EQ.1) THEN
0215                 HFGG=HFGG+FCOF*EF**2*(1D0+2D0*RM1)*BE34
0216                 HFGZ=HFGZ+FCOF*EF*VF*(1D0+2D0*RM1)*BE34
0217                 HFZZ=HFZZ+FCOF*(VF**2*(1D0+2D0*RM1)+
0218      &          AF**2*(1D0-4D0*RM1))*BE34
0219               ENDIF
0220             ENDIF
0221   170     CONTINUE
0222 C...Propagators: as simulated in PYOFSH and as desired
0223           HBW4=(1D0/PARU(1))*GMMZ/((SQM4-SQMZ)**2+GMMZ**2)
0224           MINT15=MINT(15)
0225           MINT(15)=1
0226           MINT(61)=1
0227           CALL PYWIDT(23,SQM4,WDTP,WDTE)
0228           MINT(15)=MINT15
0229           HFAEM=(PARU(108)/PARU(2))*(2D0/3D0)
0230           HFGG=HFGG*HFAEM*VINT(111)/SQM4
0231           HFGZ=HFGZ*HFAEM*VINT(112)/SQM4
0232           HFZZ=HFZZ*HFAEM*VINT(114)/SQM4
0233 C...Loop over flavours; consider full gamma/Z structure
0234           DO 180 I=MMINA,MMAXA
0235             IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 180
0236             EI=KCHG(IABS(I),1)/3D0
0237             AI=SIGN(1D0,EI)
0238             VI=AI-4D0*EI*XWV
0239             FCOI=1D0
0240             IF(IABS(I).LE.10) FCOI=FACA/3D0
0241             NCHN=NCHN+1
0242             ISIG(NCHN,1)=I
0243             ISIG(NCHN,2)=-I
0244             ISIG(NCHN,3)=1
0245             SIGH(NCHN)=FACGZ*FCOI*EI**2*(EI**2*HFGG+EI*VI*HFGZ+
0246      &      (VI**2+AI**2)*HFZZ)/HBW4
0247   180     CONTINUE
0248
0249         ELSEIF(ISUB.EQ.20) THEN
0250 C...f + fbar' -> gamma + W+/-
0251           FACGW=COMFAC*0.5D0*AEM**2/XW
0252 C...Propagators: as simulated in PYOFSH and as desired
0253           HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2)
0254           CALL PYWIDT(24,SQM4,WDTP,WDTE)
0255           GMMWC=SQRT(SQM4)*WDTP(0)
0256           HBW4C=GMMWC/((SQM4-SQMW)**2+GMMWC**2)
0257           FACGW=FACGW*HBW4C/HBW4
0258 C...Anomalous couplings
0259           TERM1=(TH2+UH2+2D0*SQM4*SH)/(TH*UH)
0260           TERM2=0D0
0261           TERM3=0D0
0262           IF(ITCM(5).GE.1.AND.ITCM(5).LE.4) THEN
0263             TERM2=RTCM(46)*(TH-UH)/(TH+UH)
0264             TERM3=0.5D0*RTCM(46)**2*(TH*UH+(TH2+UH2)*SH/
0265      &      (4D0*SQMW))/(TH+UH)**2
0266           ENDIF
0267           DO 200 I=MMIN1,MMAX1
0268             IA=IABS(I)
0269             IF(I.EQ.0.OR.IA.GT.20.OR.KFAC(1,I).EQ.0) GOTO 200
0270             DO 190 J=MMIN2,MMAX2
0271               JA=IABS(J)
0272               IF(J.EQ.0.OR.JA.GT.20.OR.KFAC(2,J).EQ.0) GOTO 190
0273               IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 190
0274               IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10))
0275      &        GOTO 190
0276               KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
0277               WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))/WDTP(0)
0278               IF(IA.LE.10) THEN
0279                 FACWR=UH/(TH+UH)-1D0/3D0
0280                 FCKM=VCKM((IA+1)/2,(JA+1)/2)
0281                 FCOI=FACA/3D0
0282               ELSE
0283                 FACWR=-TH/(TH+UH)
0284                 FCKM=1D0
0285                 FCOI=1D0
0286               ENDIF
0287               FACWK=TERM1*FACWR**2+TERM2*FACWR+TERM3
0288               NCHN=NCHN+1
0289               ISIG(NCHN,1)=I
0290               ISIG(NCHN,2)=J
0291               ISIG(NCHN,3)=1
0292               SIGH(NCHN)=FACGW*FACWK*FCOI*FCKM*WIDSC
0293   190       CONTINUE
0294   200     CONTINUE
0295         ENDIF
0296
0297       ELSEIF(ISUB.LE.40) THEN
0298         IF(ISUB.EQ.22) THEN
0299 C...f + fbar -> (gamma*/Z0) + (gamma*/Z0)
0300 C...Kinematics dependence
0301           FACZZ=COMFAC*AEM**2*((TH2+UH2+2D0*(SQM3+SQM4)*SH)/(TH*UH)-
0302      &    SQM3*SQM4*(1D0/TH2+1D0/UH2))
0303 C...gamma, gamma/Z interference and Z couplings to final fermion pairs
0304           DO 220 I=1,6
0305             DO 210 J=1,3
0306               HGZ(I,J)=0D0
0307   210       CONTINUE
0308   220     CONTINUE
0309           RADC3=1D0+PYALPS(SQM3)/PARU(1)
0310           RADC4=1D0+PYALPS(SQM4)/PARU(1)
0311           DO 230 I=1,MIN(16,MDCY(23,3))
0312             IDC=I+MDCY(23,2)-1
0313             IF(MDME(IDC,1).LT.0) GOTO 230
0314             IMDM=0
0315             IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2) IMDM=1
0316             IF(MDME(IDC,1).EQ.4.OR.MDME(IDC,1).EQ.5) IMDM=MDME(IDC,1)-2
0317             IF(I.LE.8) THEN
0318               EF=KCHG(I,1)/3D0
0319               AF=SIGN(1D0,EF+0.1D0)
0320               VF=AF-4D0*EF*XWV
0321             ELSEIF(I.LE.16) THEN
0322               EF=KCHG(I+2,1)/3D0
0323               AF=SIGN(1D0,EF+0.1D0)
0324               VF=AF-4D0*EF*XWV
0325             ENDIF
0326             RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM3
0327             IF(4D0*RM1.LT.1D0) THEN
0328               FCOF=1D0
0329               IF(I.LE.8) FCOF=3D0*RADC3
0330               BE34=SQRT(MAX(0D0,1D0-4D0*RM1))
0331               IF(IMDM.GE.1) THEN
0332                 HGZ(1,IMDM)=HGZ(1,IMDM)+FCOF*EF**2*(1D0+2D0*RM1)*BE34
0333                 HGZ(2,IMDM)=HGZ(2,IMDM)+FCOF*EF*VF*(1D0+2D0*RM1)*BE34
0334                 HGZ(3,IMDM)=HGZ(3,IMDM)+FCOF*(VF**2*(1D0+2D0*RM1)+
0335      &          AF**2*(1D0-4D0*RM1))*BE34
0336               ENDIF
0337             ENDIF
0338             RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4
0339             IF(4D0*RM1.LT.1D0) THEN
0340               FCOF=1D0
0341               IF(I.LE.8) FCOF=3D0*RADC4
0342               BE34=SQRT(MAX(0D0,1D0-4D0*RM1))
0343               IF(IMDM.GE.1) THEN
0344                 HGZ(4,IMDM)=HGZ(4,IMDM)+FCOF*EF**2*(1D0+2D0*RM1)*BE34
0345                 HGZ(5,IMDM)=HGZ(5,IMDM)+FCOF*EF*VF*(1D0+2D0*RM1)*BE34
0346                 HGZ(6,IMDM)=HGZ(6,IMDM)+FCOF*(VF**2*(1D0+2D0*RM1)+
0347      &          AF**2*(1D0-4D0*RM1))*BE34
0348               ENDIF
0349             ENDIF
0350   230     CONTINUE
0351 C...Propagators: as simulated in PYOFSH and as desired
0352           HBW3=(1D0/PARU(1))*GMMZ/((SQM3-SQMZ)**2+GMMZ**2)
0353           HBW4=(1D0/PARU(1))*GMMZ/((SQM4-SQMZ)**2+GMMZ**2)
0354           MINT15=MINT(15)
0355           MINT(15)=1
0356           MINT(61)=1
0357           CALL PYWIDT(23,SQM3,WDTP,WDTE)
0358           MINT(15)=MINT15
0359           HFAEM=(PARU(108)/PARU(2))*(2D0/3D0)
0360           DO 240 J=1,3
0361             HGZ(1,J)=HGZ(1,J)*HFAEM*VINT(111)/SQM3
0362             HGZ(2,J)=HGZ(2,J)*HFAEM*VINT(112)/SQM3
0363             HGZ(3,J)=HGZ(3,J)*HFAEM*VINT(114)/SQM3
0364   240     CONTINUE
0365           MINT15=MINT(15)
0366           MINT(15)=1
0367           MINT(61)=1
0368           CALL PYWIDT(23,SQM4,WDTP,WDTE)
0369           MINT(15)=MINT15
0370           HFAEM=(PARU(108)/PARU(2))*(2D0/3D0)
0371           DO 250 J=1,3
0372             HGZ(4,J)=HGZ(4,J)*HFAEM*VINT(111)/SQM4
0373             HGZ(5,J)=HGZ(5,J)*HFAEM*VINT(112)/SQM4
0374             HGZ(6,J)=HGZ(6,J)*HFAEM*VINT(114)/SQM4
0375   250     CONTINUE
0376 C...Loop over flavours; separate left- and right-handed couplings
0377           DO 270 I=MMINA,MMAXA
0378             IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 270
0379             EI=KCHG(IABS(I),1)/3D0
0380             AI=SIGN(1D0,EI)
0381             VI=AI-4D0*EI*XWV
0382             VALI=VI-AI
0383             VARI=VI+AI
0384             FCOI=1D0
0385             IF(IABS(I).LE.10) FCOI=FACA/3D0
0386             DO 260 J=1,3
0387               HL3(J)=EI**2*HGZ(1,J)+EI*VALI*HGZ(2,J)+VALI**2*HGZ(3,J)
0388               HR3(J)=EI**2*HGZ(1,J)+EI*VARI*HGZ(2,J)+VARI**2*HGZ(3,J)
0389               HL4(J)=EI**2*HGZ(4,J)+EI*VALI*HGZ(5,J)+VALI**2*HGZ(6,J)
0390               HR4(J)=EI**2*HGZ(4,J)+EI*VARI*HGZ(5,J)+VARI**2*HGZ(6,J)
0391   260       CONTINUE
0392             FACLR=HL3(1)*HL4(1)+HL3(1)*(HL4(2)+HL4(3))+
0393      &      HL4(1)*(HL3(2)+HL3(3))+HL3(2)*HL4(3)+HL4(2)*HL3(3)+
0394      &      HR3(1)*HR4(1)+HR3(1)*(HR4(2)+HR4(3))+
0395      &      HR4(1)*(HR3(2)+HR3(3))+HR3(2)*HR4(3)+HR4(2)*HR3(3)
0396             NCHN=NCHN+1
0397             ISIG(NCHN,1)=I
0398             ISIG(NCHN,2)=-I
0399             ISIG(NCHN,3)=1
0400             SIGH(NCHN)=0.5D0*FACZZ*FCOI*FACLR/(HBW3*HBW4)
0401   270     CONTINUE
0402
0403         ELSEIF(ISUB.EQ.23) THEN
0404 C...f + fbar' -> Z0 + W+/- (Z0 only, i.e. no gamma* admixture.)
0405           FACZW=COMFAC*0.5D0*(AEM/XW)**2
0406           FACZW=FACZW*WIDS(23,2)
0407           THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2)
0408           FACBW=1D0/((SH-SQMW)**2+GMMW**2)
0409           DO 290 I=MMIN1,MMAX1
0410             IA=IABS(I)
0411             IF(I.EQ.0.OR.IA.GT.20.OR.KFAC(1,I).EQ.0) GOTO 290
0412             DO 280 J=MMIN2,MMAX2
0413               JA=IABS(J)
0414               IF(J.EQ.0.OR.JA.GT.20.OR.KFAC(2,J).EQ.0) GOTO 280
0415               IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 280
0416               IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10))
0417      &        GOTO 280
0418               KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
0419               EI=KCHG(IA,1)/3D0
0420               AI=SIGN(1D0,EI+0.1D0)
0421               VI=AI-4D0*EI*XWV
0422               EJ=KCHG(JA,1)/3D0
0423               AJ=SIGN(1D0,EJ+0.1D0)
0424               VJ=AJ-4D0*EJ*XWV
0425               IF(VI+AI.GT.0) THEN
0426                 VISAV=VI
0427                 AISAV=AI
0428                 VI=VJ
0429                 AI=AJ
0430                 VJ=VISAV
0431                 AJ=AISAV
0432               ENDIF
0433               FCKM=1D0
0434               IF(IA.LE.10) FCKM=VCKM((IA+1)/2,(JA+1)/2)
0435               FCOI=1D0
0436               IF(IA.LE.10) FCOI=FACA/3D0
0437               NCHN=NCHN+1
0438               ISIG(NCHN,1)=I
0439               ISIG(NCHN,2)=J
0440               ISIG(NCHN,3)=1
0441               SIGH(NCHN)=FACZW*FCOI*FCKM*(FACBW*((9D0-8D0*XW)/4D0*THUH+
0442      &        (8D0*XW-6D0)/4D0*SH*(SQM3+SQM4))+(THUH-SH*(SQM3+SQM4))*
0443      &        (SH-SQMW)*FACBW*0.5D0*((VJ+AJ)/TH-(VI+AI)/UH)+
0444      &        THUH/(16D0*XW1)*((VJ+AJ)**2/TH2+(VI+AI)**2/UH2)+
0445      &        SH*(SQM3+SQM4)/(8D0*XW1)*(VI+AI)*(VJ+AJ)/(TH*UH))*
0446      &        WIDS(24,(5-KCHW)/2)
0447 C***Protect against slightly negative cross sections. (Reason yet to be
0448 C***sorted out. One possibility: addition of width to the W propagator.)
0449               SIGH(NCHN)=MAX(0D0,SIGH(NCHN))
0450   280       CONTINUE
0451   290     CONTINUE
0452
0453         ELSEIF(ISUB.EQ.25) THEN
0454 C...f + fbar -> W+ + W-
0455 C...Propagators: Z0, W+- as simulated in PYOFSH and as desired
0456           GMMZC=GMMZ
0457           HBWZC=SH**2/((SH-SQMZ)**2+GMMZC**2)
0458           HBW3=GMMW/((SQM3-SQMW)**2+GMMW**2)
0459           CALL PYWIDT(24,SQM3,WDTP,WDTE)
0460           GMMW3=SQRT(SQM3)*WDTP(0)
0461           HBW3C=GMMW3/((SQM3-SQMW)**2+GMMW3**2)
0462           HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2)
0463           CALL PYWIDT(24,SQM4,WDTP,WDTE)
0464           GMMW4=SQRT(SQM4)*WDTP(0)
0465           HBW4C=GMMW4/((SQM4-SQMW)**2+GMMW4**2)
0466 C...Kinematical functions
0467           THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2)
0468           THUH34=(2D0*SH*(SQM3+SQM4)+THUH)/(SQM3*SQM4)
0469           GS=(((SH-SQM3-SQM4)**2-4D0*SQM3*SQM4)*THUH34+12D0*THUH)/SH2
0470           GT=THUH34+4D0*THUH/TH2
0471           GST=((SH-SQM3-SQM4)*THUH34+4D0*(SH*(SQM3+SQM4)-THUH)/TH)/SH
0472           GU=THUH34+4D0*THUH/UH2
0473           GSU=((SH-SQM3-SQM4)*THUH34+4D0*(SH*(SQM3+SQM4)-THUH)/UH)/SH
0474 C...Common factors and couplings
0475           FACWW=COMFAC*(HBW3C/HBW3)*(HBW4C/HBW4)
0476           FACWW=FACWW*WIDS(24,1)
0477           CGG=AEM**2/2D0
0478           CGZ=AEM**2/(4D0*XW)*HBWZC*(1D0-SQMZ/SH)
0479           CZZ=AEM**2/(32D0*XW**2)*HBWZC
0480           CNG=AEM**2/(4D0*XW)
0481           CNZ=AEM**2/(16D0*XW**2)*HBWZC*(1D0-SQMZ/SH)
0482           CNN=AEM**2/(16D0*XW**2)
0483 C...Coulomb factor for W+W- pair
0484           IF(MSTP(40).GE.1.AND.MSTP(40).LE.3) THEN
0485             COULE=(SH-4D0*SQMW)/(4D0*PMAS(24,1))
0486             COULP=MAX(1D-10,0.5D0*BE34*SQRT(SH))
0487             IF(COULE.LT.100D0*PMAS(24,2)) THEN
0488               COULP1=SQRT(0.5D0*PMAS(24,1)*(SQRT(COULE**2+
0489      &        PMAS(24,2)**2)-COULE))
0490             ELSE
0491               COULP1=SQRT(0.5D0*PMAS(24,1)*(0.5D0*PMAS(24,2)**2/COULE))
0492             ENDIF
0493             IF(COULE.GT.-100D0*PMAS(24,2)) THEN
0494               COULP2=SQRT(0.5D0*PMAS(24,1)*(SQRT(COULE**2+
0495      &        PMAS(24,2)**2)+COULE))
0496             ELSE
0497               COULP2=SQRT(0.5D0*PMAS(24,1)*(0.5D0*PMAS(24,2)**2/
0498      &        ABS(COULE)))
0499             ENDIF
0500             IF(MSTP(40).EQ.1) THEN
0501               COULDC=PARU(1)-2D0*ATAN((COULP1**2+COULP2**2-COULP**2)/
0502      &        MAX(1D-10,2D0*COULP*COULP1))
0503               FACCOU=1D0+0.5D0*PARU(101)*COULDC/MAX(1D-5,BE34)
0504             ELSEIF(MSTP(40).EQ.2) THEN
0505               COULCK=DCMPLX(DBLE(COULP1),DBLE(COULP2))
0506               COULCP=DCMPLX(0D0,DBLE(COULP))
0507               COULCD=(COULCK+COULCP)/(COULCK-COULCP)
0508               COULCR=1D0+DBLE(PARU(101)*SQRT(SH))/
0509      &        (4D0*COULCP)*LOG(COULCD)
0510               COULCS=DCMPLX(0D0,0D0)
0511               NSTP=100
0512               DO 300 ISTP=1,NSTP
0513                 COULXX=(ISTP-0.5)/NSTP
0514                 COULCS=COULCS+(1D0/COULXX)*LOG((1D0+COULXX*COULCD)/
0515      &          (1D0+COULXX/COULCD))
0516   300         CONTINUE
0517               COULCR=COULCR+DBLE(PARU(101)**2*SH)/(16D0*COULCP*COULCK)*
0518      &        (COULCS/NSTP)
0519               FACCOU=ABS(COULCR)**2
0520             ELSEIF(MSTP(40).EQ.3) THEN
0521               COULDC=PARU(1)-2D0*(1D0-BE34)**2*ATAN((COULP1**2+
0522      &        COULP2**2-COULP**2)/MAX(1D-10,2D0*COULP*COULP1))
0523               FACCOU=1D0+0.5D0*PARU(101)*COULDC/MAX(1D-5,BE34)
0524             ENDIF
0525           ELSEIF(MSTP(40).EQ.4) THEN
0526             FACCOU=1D0+0.5D0*PARU(101)*PARU(1)/MAX(1D-5,BE34)
0527           ELSE
0528             FACCOU=1D0
0529           ENDIF
0530           VINT(95)=FACCOU
0531           FACWW=FACWW*FACCOU
0532 C...Loop over allowed flavours
0533           DO 310 I=MMINA,MMAXA
0534             IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 310
0535             EI=KCHG(IABS(I),1)/3D0
0536             AI=SIGN(1D0,EI+0.1D0)
0537             VI=AI-4D0*EI*XWV
0538             FCOI=1D0
0539             IF(IABS(I).LE.10) FCOI=FACA/3D0
0540             IF(MSTP(50).LE.0.OR.IABS(I).LE.10) THEN
0541               IF(AI.LT.0D0) THEN
0542                 DSIGWW=(CGG*EI**2+CGZ*VI*EI+CZZ*(VI**2+AI**2))*GS+
0543      &          (CNG*EI+CNZ*(VI+AI))*GST+CNN*GT
0544               ELSE
0545                 DSIGWW=(CGG*EI**2+CGZ*VI*EI+CZZ*(VI**2+AI**2))*GS-
0546      &          (CNG*EI+CNZ*(VI+AI))*GSU+CNN*GU
0547               ENDIF
0548             ELSE
0549               XMW02=0.5D0*(SQM3+SQM4)-0.25D0*(SQM3-SQM4)**2/SH
0550               BET=SQRT(1D0-4D0*XMW02/SH)
0551               GAT=1D0/SQRT(1D0-BET**2)
0552               STHE2=1D0-CTH**2
0553               AMPZG=BET**3*(16D0+(4D0*BET**2*GAT**2+3D0/GAT**2)*STHE2)
0554               AMPNU=BET*(2D0+BET**2*GAT**2*STHE2/2D0+
0555      &        2D0*BET**2*(1D0-BET**2)*STHE2/(1D0-2D0*BET*CTH+BET**2)**2)
0556               AMPNG=BET*((1D0+BET**2)*(4D0+BET**2*GAT**2*STHE2)+
0557      &        2D0*(1D0-BET**2)*(BET**2*STHE2-2D0*(1D0-BET**2))/
0558      &        (1D0-2D0*BET*CTH+BET**2))
0559               PROPI1=(0.25D0*SQMZ/XMW02)*HBWZC*(1D0-SQMZ/SH)
0560               PROPI2=(0.25D0*SQMZ/XMW02)**2*HBWZC
0561               A0=(2D0*(XMW02/SQMZ)-(1D0-BET**2)*XW)*POLL
0562               A1=(2D0*(XMW02/SQMZ)**2-2*XMW02/SQMZ*(1D0-BET**2)*XW)*POLL
0563               A2=(1D0-BET**2)**2*XW**2*(POLR+POLL)/2D0
0564               ATOT=AMPNU*POLL+(A1+A2)*PROPI2*AMPZG-A0*PROPI1*AMPNG
0565               ATOT=ATOT*CNN/SQMW*SH/BET*2D0
0566               DSIGWW=ATOT
0567             ENDIF
0568             NCHN=NCHN+1
0569             ISIG(NCHN,1)=I
0570             ISIG(NCHN,2)=-I
0571             ISIG(NCHN,3)=1
0572             SIGH(NCHN)=FACWW*FCOI*DSIGWW
0573   310     CONTINUE
0574
0575         ELSEIF(ISUB.EQ.30) THEN
0576 C...f + g -> f + (gamma*/Z0) (q + g -> q + (gamma*/Z0) only)
0577           FZQ=COMFAC*FACA*AS*AEM*(1D0/3D0)*(SH2+UH2+2D0*SQM4*TH)/
0578      &    (-SH*UH)
0579 C...gamma, gamma/Z interference and Z couplings to final fermion pairs
0580           HFGG=0D0
0581           HFGZ=0D0
0582           HFZZ=0D0
0583           RADC4=1D0+PYALPS(SQM4)/PARU(1)
0584           DO 320 I=1,MIN(16,MDCY(23,3))
0585             IDC=I+MDCY(23,2)-1
0586             IF(MDME(IDC,1).LT.0) GOTO 320
0587             IMDM=0
0588             IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2.OR.MDME(IDC,1).EQ.4)
0589      &      IMDM=1
0590             IF(I.LE.8) THEN
0591               EF=KCHG(I,1)/3D0
0592               AF=SIGN(1D0,EF+0.1D0)
0593               VF=AF-4D0*EF*XWV
0594             ELSEIF(I.LE.16) THEN
0595               EF=KCHG(I+2,1)/3D0
0596               AF=SIGN(1D0,EF+0.1D0)
0597               VF=AF-4D0*EF*XWV
0598             ENDIF
0599             RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4
0600             IF(4D0*RM1.LT.1D0) THEN
0601               FCOF=1D0
0602               IF(I.LE.8) FCOF=3D0*RADC4
0603               BE34=SQRT(MAX(0D0,1D0-4D0*RM1))
0604               IF(IMDM.EQ.1) THEN
0605                 HFGG=HFGG+FCOF*EF**2*(1D0+2D0*RM1)*BE34
0606                 HFGZ=HFGZ+FCOF*EF*VF*(1D0+2D0*RM1)*BE34
0607                 HFZZ=HFZZ+FCOF*(VF**2*(1D0+2D0*RM1)+
0608      &          AF**2*(1D0-4D0*RM1))*BE34
0609               ENDIF
0610             ENDIF
0611   320     CONTINUE
0612 C...Propagators: as simulated in PYOFSH and as desired
0613           HBW4=(1D0/PARU(1))*GMMZ/((SQM4-SQMZ)**2+GMMZ**2)
0614           MINT15=MINT(15)
0615           MINT(15)=1
0616           MINT(61)=1
0617           CALL PYWIDT(23,SQM4,WDTP,WDTE)
0618           MINT(15)=MINT15
0619           HFAEM=(PARU(108)/PARU(2))*(2D0/3D0)
0620           HFGG=HFGG*HFAEM*VINT(111)/SQM4
0621           HFGZ=HFGZ*HFAEM*VINT(112)/SQM4
0622           HFZZ=HFZZ*HFAEM*VINT(114)/SQM4
0623 C...Loop over flavours; consider full gamma/Z structure
0624           DO 340 I=MMINA,MMAXA
0625             IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 340
0626             EI=KCHG(IABS(I),1)/3D0
0627             AI=SIGN(1D0,EI)
0628             VI=AI-4D0*EI*XWV
0629             FACZQ=FZQ*(EI**2*HFGG+EI*VI*HFGZ+
0630      &      (VI**2+AI**2)*HFZZ)/HBW4
0631             DO 330 ISDE=1,2
0632               IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 330
0633               IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 330
0634               NCHN=NCHN+1
0635               ISIG(NCHN,ISDE)=I
0636               ISIG(NCHN,3-ISDE)=21
0637               ISIG(NCHN,3)=1
0638               SIGH(NCHN)=FACZQ
0639   330       CONTINUE
0640   340     CONTINUE
0641
0642         ELSEIF(ISUB.EQ.31) THEN
0643 C...f + g -> f' + W+/- (q + g -> q' + W+/- only)
0644           FACWQ=COMFAC*FACA*AS*AEM/XW*1D0/12D0*
0645      &    (SH2+UH2+2D0*SQM4*TH)/(-SH*UH)
0646 C...Propagators: as simulated in PYOFSH and as desired
0647           HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2)
0648           CALL PYWIDT(24,SQM4,WDTP,WDTE)
0649           GMMWC=SQRT(SQM4)*WDTP(0)
0650           HBW4C=GMMWC/((SQM4-SQMW)**2+GMMWC**2)
0651           FACWQ=FACWQ*HBW4C/HBW4
0652           DO 360 I=MMINA,MMAXA
0653             IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 360
0654             IA=IABS(I)
0655             KCHW=ISIGN(1,KCHG(IA,1)*ISIGN(1,I))
0656             WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))/WDTP(0)
0657             DO 350 ISDE=1,2
0658               IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 350
0659               IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 350
0660               NCHN=NCHN+1
0661               ISIG(NCHN,ISDE)=I
0662               ISIG(NCHN,3-ISDE)=21
0663               ISIG(NCHN,3)=1
0664               SIGH(NCHN)=FACWQ*VINT(180+I)*WIDSC
0665   350       CONTINUE
0666   360     CONTINUE
0667
0668         ELSEIF(ISUB.EQ.35) THEN
0669 C...f + gamma -> f + (gamma*/Z0)
0670           IF(MINT(15).EQ.22.AND.VINT(3).LT.0D0) THEN
0671             FZQN=SH2+UH2+2D0*(SQM4-VINT(3)**2)*TH
0672             FZQDTM=VINT(3)**2*SQM4-SH*(UH-VINT(4)**2)
0673           ELSEIF(MINT(16).EQ.22.AND.VINT(4).LT.0D0) THEN
0674             FZQN=SH2+UH2+2D0*(SQM4-VINT(4)**2)*TH
0675             FZQDTM=VINT(4)**2*SQM4-SH*(UH-VINT(3)**2)
0676           ELSE
0677             FZQN=SH2+UH2+2D0*SQM4*TH
0678             FZQDTM=-SH*UH
0679           ENDIF
0680           FZQN=COMFAC*2D0*AEM**2*MAX(0D0,FZQN)
0681 C...gamma, gamma/Z interference and Z couplings to final fermion pairs
0682           HFGG=0D0
0683           HFGZ=0D0
0684           HFZZ=0D0
0685           RADC4=1D0+PYALPS(SQM4)/PARU(1)
0686           DO 370 I=1,MIN(16,MDCY(23,3))
0687             IDC=I+MDCY(23,2)-1
0688             IF(MDME(IDC,1).LT.0) GOTO 370
0689             IMDM=0
0690             IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2.OR.MDME(IDC,1).EQ.4)
0691      &      IMDM=1
0692             IF(I.LE.8) THEN
0693               EF=KCHG(I,1)/3D0
0694               AF=SIGN(1D0,EF+0.1D0)
0695               VF=AF-4D0*EF*XWV
0696             ELSEIF(I.LE.16) THEN
0697               EF=KCHG(I+2,1)/3D0
0698               AF=SIGN(1D0,EF+0.1D0)
0699               VF=AF-4D0*EF*XWV
0700             ENDIF
0701             RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4
0702             IF(4D0*RM1.LT.1D0) THEN
0703               FCOF=1D0
0704               IF(I.LE.8) FCOF=3D0*RADC4
0705               BE34=SQRT(MAX(0D0,1D0-4D0*RM1))
0706               IF(IMDM.EQ.1) THEN
0707                 HFGG=HFGG+FCOF*EF**2*(1D0+2D0*RM1)*BE34
0708                 HFGZ=HFGZ+FCOF*EF*VF*(1D0+2D0*RM1)*BE34
0709                 HFZZ=HFZZ+FCOF*(VF**2*(1D0+2D0*RM1)+
0710      &          AF**2*(1D0-4D0*RM1))*BE34
0711               ENDIF
0712             ENDIF
0713   370     CONTINUE
0714 C...Propagators: as simulated in PYOFSH and as desired
0715           HBW4=(1D0/PARU(1))*GMMZ/((SQM4-SQMZ)**2+GMMZ**2)
0716           MINT15=MINT(15)
0717           MINT(15)=1
0718           MINT(61)=1
0719           CALL PYWIDT(23,SQM4,WDTP,WDTE)
0720           MINT(15)=MINT15
0721           HFAEM=(PARU(108)/PARU(2))*(2D0/3D0)
0722           HFGG=HFGG*HFAEM*VINT(111)/SQM4
0723           HFGZ=HFGZ*HFAEM*VINT(112)/SQM4
0724           HFZZ=HFZZ*HFAEM*VINT(114)/SQM4
0725 C...Loop over flavours; consider full gamma/Z structure
0726           DO 390 I=MMINA,MMAXA
0727             IF(I.EQ.0) GOTO 390
0728             EI=KCHG(IABS(I),1)/3D0
0729             AI=SIGN(1D0,EI)
0730             VI=AI-4D0*EI*XWV
0731             FACZQ=EI**2*(EI**2*HFGG+EI*VI*HFGZ+
0732      &      (VI**2+AI**2)*HFZZ)/HBW4
0733             FZQD=MAX(PMAS(IABS(I),1)**2*SQM4,FZQDTM)
0734             DO 380 ISDE=1,2
0735               IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 380
0736               IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 380
0737               NCHN=NCHN+1
0738               ISIG(NCHN,ISDE)=I
0739               ISIG(NCHN,3-ISDE)=22
0740               ISIG(NCHN,3)=1
0741               SIGH(NCHN)=FACZQ*FZQN/FZQD
0742   380       CONTINUE
0743   390     CONTINUE
0744
0745         ELSEIF(ISUB.EQ.36) THEN
0746 C...f + gamma -> f' + W+/-
0747           FWQ=COMFAC*AEM**2/(2D0*XW)*
0748      &    (SH2+UH2+2D0*SQM4*TH)/(SQPTH*SQM4-SH*UH)
0749 C...Propagators: as simulated in PYOFSH and as desired
0750           HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2)
0751           CALL PYWIDT(24,SQM4,WDTP,WDTE)
0752           GMMWC=SQRT(SQM4)*WDTP(0)
0753           HBW4C=GMMWC/((SQM4-SQMW)**2+GMMWC**2)
0754           FWQ=FWQ*HBW4C/HBW4
0755           DO 410 I=MMINA,MMAXA
0756             IF(I.EQ.0) GOTO 410
0757             IA=IABS(I)
0758             EIA=ABS(KCHG(IABS(I),1)/3D0)
0759             FACWQ=FWQ*(EIA-SH/(SH+UH))**2
0760             KCHW=ISIGN(1,KCHG(IA,1)*ISIGN(1,I))
0761             WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))/WDTP(0)
0762             DO 400 ISDE=1,2
0763               IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 400
0764               IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 400
0765               NCHN=NCHN+1
0766               ISIG(NCHN,ISDE)=I
0767               ISIG(NCHN,3-ISDE)=22
0768               ISIG(NCHN,3)=1
0769               SIGH(NCHN)=FACWQ*VINT(180+I)*WIDSC
0770   400       CONTINUE
0771   410     CONTINUE
0772         ENDIF
0773
0774       ELSEIF(ISUB.LE.100) THEN
0775         IF(ISUB.EQ.69) THEN
0776 C...gamma + gamma -> W+ + W-
0777           SQMWE=MAX(0.5D0*SQMW,SQRT(SQM3*SQM4))
0778           FPROP=SH2/((SQMWE-TH)*(SQMWE-UH))
0779           FACWW=COMFAC*6D0*AEM**2*(1D0-FPROP*(4D0/3D0+2D0*SQMWE/SH)+
0780      &    FPROP**2*(2D0/3D0+2D0*(SQMWE/SH)**2))*WIDS(24,1)
0781           IF(KFAC(1,22)*KFAC(2,22).EQ.0) GOTO 420
0782           NCHN=NCHN+1
0783           ISIG(NCHN,1)=22
0784           ISIG(NCHN,2)=22
0785           ISIG(NCHN,3)=1
0786           SIGH(NCHN)=FACWW
0787   420     CONTINUE
0788
0789         ELSEIF(ISUB.EQ.70) THEN
0790 C...gamma + W+/- -> Z0 + W+/-
0791           SQMWE=MAX(0.5D0*SQMW,SQRT(SQM3*SQM4))
0792           FPROP=(TH-SQMWE)**2/(-SH*(SQMWE-UH))
0793           FACZW=COMFAC*6D0*AEM**2*(XW1/XW)*
0794      &    (1D0-FPROP*(4D0/3D0+2D0*SQMWE/(TH-SQMWE))+
0795      &    FPROP**2*(2D0/3D0+2D0*(SQMWE/(TH-SQMWE))**2))*WIDS(23,2)
0796           DO 440 KCHW=1,-1,-2
0797             DO 430 ISDE=1,2
0798               IF(KFAC(ISDE,22)*KFAC(3-ISDE,24*KCHW).EQ.0) GOTO 430
0799               NCHN=NCHN+1
0800               ISIG(NCHN,ISDE)=22
0801               ISIG(NCHN,3-ISDE)=24*KCHW
0802               ISIG(NCHN,3)=1
0803               SIGH(NCHN)=FACZW*WIDS(24,(5-KCHW)/2)
0804   430       CONTINUE
0805   440     CONTINUE
0806         ENDIF
0807       ENDIF
0808
0809       RETURN
0810       END