hijing/src/pyhiwidt.f

0001
0002 C*********************************************************************
0003
0004       SUBROUTINE PYHIWIDT(KFLR,RMAS,WDTP,WDTE)
0005
0006 C...Calculates full and partial widths of resonances.
0007       COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0008       SAVE /LUDAT1/
0009       COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
0010       SAVE /LUDAT2/
0011       COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
0012       SAVE /LUDAT3/
0013       COMMON/PYHIPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
0014       SAVE /PYHIPARS/
0015       COMMON/PYHIINT1/MINT(400),VINT(400)
0016       SAVE /PYHIINT1/
0017       COMMON/PYHIINT4/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3)
0018       SAVE /PYHIINT4/
0019       DIMENSION WDTP(0:40),WDTE(0:40,0:5)
0020
0021 C...Some common constants.
0022       KFLA=IABS(KFLR)
0023       SQM=RMAS**2
0024       AS=ULALPS(SQM)
0025       AEM=PARU(101)
0026       XW=PARU(102)
0027       RADC=1.+AS/PARU(1)
0028
0029 C...Reset width information.
0030       DO 100 I=0,40
0031       WDTP(I)=0.
0032       DO 100 J=0,5
0033   100 WDTE(I,J)=0.
0034
0035       IF(KFLA.EQ.21) THEN
0036 C...QCD:
0037         DO 110 I=1,MDCY(21,3)
0038         IDC=I+MDCY(21,2)-1
0039         RM1=(PMAS(IABS(KFDP(IDC,1)),1)/RMAS)**2
0040         RM2=(PMAS(IABS(KFDP(IDC,2)),1)/RMAS)**2
0041         IF(SQRT(RM1)+SQRT(RM2).GT.1..OR.MDME(IDC,1).LT.0) GOTO 110
0042         IF(I.LE.8) THEN
0043 C...QCD -> q + qb
0044           WDTP(I)=(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))
0045           WID2=1.
0046         ENDIF
0047         WDTP(0)=WDTP(0)+WDTP(I)
0048         IF(MDME(IDC,1).GT.0) THEN
0049           WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
0050           WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
0051           WDTE(I,0)=WDTE(I,MDME(IDC,1))
0052           WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
0053         ENDIF
0054   110   CONTINUE
0055
0056       ELSEIF(KFLA.EQ.23) THEN
0057 C...Z0:
0058         IF(MINT(61).EQ.1) THEN
0059           EI=KCHG(IABS(MINT(15)),1)/3.
0060           AI=SIGN(1.,EI)
0061           VI=AI-4.*EI*XW
0062           SQMZ=PMAS(23,1)**2
0063           GZMZ=PMAS(23,2)*PMAS(23,1)
0064           GGI=EI**2
0065           GZI=EI*VI/(8.*XW*(1.-XW))*SQM*(SQM-SQMZ)/
0066      &    ((SQM-SQMZ)**2+GZMZ**2)
0067           ZZI=(VI**2+AI**2)/(16.*XW*(1.-XW))**2*SQM**2/
0068      &    ((SQM-SQMZ)**2+GZMZ**2)
0069           IF(MSTP(43).EQ.1) THEN
0070 C...Only gamma* production included
0071             GZI=0.
0072             ZZI=0.
0073           ELSEIF(MSTP(43).EQ.2) THEN
0074 C...Only Z0 production included
0075             GGI=0.
0076             GZI=0.
0077           ENDIF
0078         ELSEIF(MINT(61).EQ.2) THEN
0079           VINT(111)=0.
0080           VINT(112)=0.
0081           VINT(114)=0.
0082         ENDIF
0083         DO 120 I=1,MDCY(23,3)
0084         IDC=I+MDCY(23,2)-1
0085         RM1=(PMAS(IABS(KFDP(IDC,1)),1)/RMAS)**2
0086         RM2=(PMAS(IABS(KFDP(IDC,2)),1)/RMAS)**2
0087         IF(SQRT(RM1)+SQRT(RM2).GT.1..OR.MDME(IDC,1).LT.0) GOTO 120
0088         IF(I.LE.8) THEN
0089 C...Z0 -> q + qb
0090           EF=KCHG(I,1)/3.
0091           AF=SIGN(1.,EF+0.1)
0092           VF=AF-4.*EF*XW
0093           IF(MINT(61).EQ.0) THEN
0094             WDTP(I)=3.*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*
0095      &      SQRT(MAX(0.,1.-4.*RM1))*RADC
0096           ELSEIF(MINT(61).EQ.1) THEN
0097             WDTP(I)=3.*((GGI*EF**2+GZI*EF*VF+ZZI*VF**2)*
0098      &      (1.+2.*RM1)+ZZI*AF**2*(1.-4.*RM1))*
0099      &      SQRT(MAX(0.,1.-4.*RM1))*RADC
0100           ELSEIF(MINT(61).EQ.2) THEN
0101             GGF=3.*EF**2*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))*RADC
0102             GZF=3.*EF*VF*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))*RADC
0103             ZZF=3.*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*
0104      &      SQRT(MAX(0.,1.-4.*RM1))*RADC
0105           ENDIF
0106           WID2=1.
0107         ELSEIF(I.LE.16) THEN
0108 C...Z0 -> l+ + l-, nu + nub
0109           EF=KCHG(I+2,1)/3.
0110           AF=SIGN(1.,EF+0.1)
0111           VF=AF-4.*EF*XW
0112           WDTP(I)=(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*
0113      &    SQRT(MAX(0.,1.-4.*RM1))
0114           IF(MINT(61).EQ.0) THEN
0115             WDTP(I)=(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*
0116      &      SQRT(MAX(0.,1.-4.*RM1))
0117           ELSEIF(MINT(61).EQ.1) THEN
0118             WDTP(I)=((GGI*EF**2+GZI*EF*VF+ZZI*VF**2)*
0119      &      (1.+2.*RM1)+ZZI*AF**2*(1.-4.*RM1))*
0120      &      SQRT(MAX(0.,1.-4.*RM1))
0121           ELSEIF(MINT(61).EQ.2) THEN
0122             GGF=EF**2*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))
0123             GZF=EF*VF*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))
0124             ZZF=(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*
0125      &      SQRT(MAX(0.,1.-4.*RM1))
0126           ENDIF
0127           WID2=1.
0128         ELSE
0129 C...Z0 -> H+ + H-
0130           CF=2.*(1.-2.*XW)
0131           IF(MINT(61).EQ.0) THEN
0132             WDTP(I)=0.25*CF**2*(1.-4.*RM1)*SQRT(MAX(0.,1.-4.*RM1))
0133           ELSEIF(MINT(61).EQ.1) THEN
0134             WDTP(I)=0.25*(GGI+GZI*CF+ZZI*CF**2)*(1.-4.*RM1)*
0135      &      SQRT(MAX(0.,1.-4.*RM1))
0136           ELSEIF(MINT(61).EQ.2) THEN
0137             GGF=0.25*(1.-4.*RM1)*SQRT(MAX(0.,1.-4.*RM1))
0138             GZF=0.25*CF*(1.-4.*RM1)*SQRT(MAX(0.,1.-4.*RM1))
0139             ZZF=0.25*CF**2*(1.-4.*RM1)*SQRT(MAX(0.,1.-4.*RM1))
0140           ENDIF
0141           WID2=WIDS(37,1)
0142         ENDIF
0143         WDTP(0)=WDTP(0)+WDTP(I)
0144         IF(MDME(IDC,1).GT.0) THEN
0145           WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
0146           WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
0147           WDTE(I,0)=WDTE(I,MDME(IDC,1))
0148           WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
0149           VINT(111)=VINT(111)+GGF*WID2
0150           VINT(112)=VINT(112)+GZF*WID2
0151           VINT(114)=VINT(114)+ZZF*WID2
0152         ENDIF
0153   120   CONTINUE
0154         IF(MSTP(43).EQ.1) THEN
0155 C...Only gamma* production included
0156           VINT(112)=0.
0157           VINT(114)=0.
0158         ELSEIF(MSTP(43).EQ.2) THEN
0159 C...Only Z0 production included
0160           VINT(111)=0.
0161           VINT(112)=0.
0162         ENDIF
0163
0164       ELSEIF(KFLA.EQ.24) THEN
0165 C...W+/-:
0166         DO 130 I=1,MDCY(24,3)
0167         IDC=I+MDCY(24,2)-1
0168         RM1=(PMAS(IABS(KFDP(IDC,1)),1)/RMAS)**2
0169         RM2=(PMAS(IABS(KFDP(IDC,2)),1)/RMAS)**2
0170         IF(SQRT(RM1)+SQRT(RM2).GT.1..OR.MDME(IDC,1).LT.0) GOTO 130
0171         IF(I.LE.16) THEN
0172 C...W+/- -> q + qb'
0173           WDTP(I)=3.*(2.-RM1-RM2-(RM1-RM2)**2)*
0174      &    SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))*
0175      &    VCKM((I-1)/4+1,MOD(I-1,4)+1)*RADC
0176           WID2=1.
0177         ELSE
0178 C...W+/- -> l+/- + nu
0179           WDTP(I)=(2.-RM1-RM2-(RM1-RM2)**2)*
0180      &    SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))
0181           WID2=1.
0182         ENDIF
0183         WDTP(0)=WDTP(0)+WDTP(I)
0184         IF(MDME(IDC,1).GT.0) THEN
0185           WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
0186           WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
0187           WDTE(I,0)=WDTE(I,MDME(IDC,1))
0188           WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
0189         ENDIF
0190   130   CONTINUE
0191
0192       ELSEIF(KFLA.EQ.25) THEN
0193 C...H0:
0194         DO 170 I=1,MDCY(25,3)
0195         IDC=I+MDCY(25,2)-1
0196         RM1=(PMAS(IABS(KFDP(IDC,1)),1)/RMAS)**2
0197         RM2=(PMAS(IABS(KFDP(IDC,2)),1)/RMAS)**2
0198         IF(SQRT(RM1)+SQRT(RM2).GT.1..OR.MDME(IDC,1).LT.0) GOTO 170
0199         IF(I.LE.8) THEN
0200 C...H0 -> q + qb
0201           WDTP(I)=3.*RM1*(1.-4.*RM1)*SQRT(MAX(0.,1.-4.*RM1))*RADC
0202           WID2=1.
0203         ELSEIF(I.LE.12) THEN
0204 C...H0 -> l+ + l-
0205           WDTP(I)=RM1*(1.-4.*RM1)*SQRT(MAX(0.,1.-4.*RM1))
0206           WID2=1.
0207         ELSEIF(I.EQ.13) THEN
0208 C...H0 -> g + g; quark loop contribution only
0209           ETARE=0.
0210           ETAIM=0.
0211           DO 140 J=1,2*MSTP(1)
0212           EPS=(2.*PMAS(J,1)/RMAS)**2
0213           IF(EPS.LE.1.) THEN
0214             IF(EPS.GT.1.E-4) THEN
0215               ROOT=SQRT(1.-EPS)
0216               RLN=LOG((1.+ROOT)/(1.-ROOT))
0217             ELSE
0218               RLN=LOG(4./EPS-2.)
0219             ENDIF
0220             PHIRE=0.25*(RLN**2-PARU(1)**2)
0221             PHIIM=0.5*PARU(1)*RLN
0222           ELSE
0223             PHIRE=-(ASIN(1./SQRT(EPS)))**2
0224             PHIIM=0.
0225           ENDIF
0226           ETARE=ETARE+0.5*EPS*(1.+(EPS-1.)*PHIRE)
0227           ETAIM=ETAIM+0.5*EPS*(EPS-1.)*PHIIM
0228   140     CONTINUE
0229           ETA2=ETARE**2+ETAIM**2
0230           WDTP(I)=(AS/PARU(1))**2*ETA2
0231           WID2=1.
0232         ELSEIF(I.EQ.14) THEN
0233 C...H0 -> gamma + gamma; quark, charged lepton and W loop contributions
0234           ETARE=0.
0235           ETAIM=0.
0236           DO 150 J=1,3*MSTP(1)+1
0237           IF(J.LE.2*MSTP(1)) THEN
0238             EJ=KCHG(J,1)/3.
0239             EPS=(2.*PMAS(J,1)/RMAS)**2
0240           ELSEIF(J.LE.3*MSTP(1)) THEN
0241             JL=2*(J-2*MSTP(1))-1
0242             EJ=KCHG(10+JL,1)/3.
0243             EPS=(2.*PMAS(10+JL,1)/RMAS)**2
0244           ELSE
0245             EPS=(2.*PMAS(24,1)/RMAS)**2
0246           ENDIF
0247           IF(EPS.LE.1.) THEN
0248             IF(EPS.GT.1.E-4) THEN
0249               ROOT=SQRT(1.-EPS)
0250               RLN=LOG((1.+ROOT)/(1.-ROOT))
0251             ELSE
0252               RLN=LOG(4./EPS-2.)
0253             ENDIF
0254             PHIRE=0.25*(RLN**2-PARU(1)**2)
0255             PHIIM=0.5*PARU(1)*RLN
0256           ELSE
0257             PHIRE=-(ASIN(1./SQRT(EPS)))**2
0258             PHIIM=0.
0259           ENDIF
0260           IF(J.LE.2*MSTP(1)) THEN
0261             ETARE=ETARE+0.5*3.*EJ**2*EPS*(1.+(EPS-1.)*PHIRE)
0262             ETAIM=ETAIM+0.5*3.*EJ**2*EPS*(EPS-1.)*PHIIM
0263           ELSEIF(J.LE.3*MSTP(1)) THEN
0264             ETARE=ETARE+0.5*EJ**2*EPS*(1.+(EPS-1.)*PHIRE)
0265             ETAIM=ETAIM+0.5*EJ**2*EPS*(EPS-1.)*PHIIM
0266           ELSE
0267             ETARE=ETARE-0.5-0.75*EPS*(1.+(EPS-2.)*PHIRE)
0268             ETAIM=ETAIM+0.75*EPS*(EPS-2.)*PHIIM
0269           ENDIF
0270   150     CONTINUE
0271           ETA2=ETARE**2+ETAIM**2
0272           WDTP(I)=(AEM/PARU(1))**2*0.5*ETA2
0273           WID2=1.
0274         ELSEIF(I.EQ.15) THEN
0275 C...H0 -> gamma + Z0; quark, charged lepton and W loop contributions
0276           ETARE=0.
0277           ETAIM=0.
0278           DO 160 J=1,3*MSTP(1)+1
0279           IF(J.LE.2*MSTP(1)) THEN
0280             EJ=KCHG(J,1)/3.
0281             AJ=SIGN(1.,EJ+0.1)
0282             VJ=AJ-4.*EJ*XW
0283             EPS=(2.*PMAS(J,1)/RMAS)**2
0284             EPSP=(2.*PMAS(J,1)/PMAS(23,1))**2
0285           ELSEIF(J.LE.3*MSTP(1)) THEN
0286             JL=2*(J-2*MSTP(1))-1
0287             EJ=KCHG(10+JL,1)/3.
0288             AJ=SIGN(1.,EJ+0.1)
0289             VJ=AI-4.*EJ*XW
0290             EPS=(2.*PMAS(10+JL,1)/RMAS)**2
0291             EPSP=(2.*PMAS(10+JL,1)/PMAS(23,1))**2
0292           ELSE
0293             EPS=(2.*PMAS(24,1)/RMAS)**2
0294             EPSP=(2.*PMAS(24,1)/PMAS(23,1))**2
0295           ENDIF
0296           IF(EPS.LE.1.) THEN
0297             ROOT=SQRT(1.-EPS)
0298             IF(EPS.GT.1.E-4) THEN
0299               RLN=LOG((1.+ROOT)/(1.-ROOT))
0300             ELSE
0301               RLN=LOG(4./EPS-2.)
0302             ENDIF
0303             PHIRE=0.25*(RLN**2-PARU(1)**2)
0304             PHIIM=0.5*PARU(1)*RLN
0305             PSIRE=-(1.+0.5*ROOT*RLN)
0306             PSIIM=0.5*PARU(1)*ROOT
0307           ELSE
0308             PHIRE=-(ASIN(1./SQRT(EPS)))**2
0309             PHIIM=0.
0310             PSIRE=-(1.+SQRT(EPS-1.)*ASIN(1./SQRT(EPS)))
0311             PSIIM=0.
0312           ENDIF
0313           IF(EPSP.LE.1.) THEN
0314             ROOT=SQRT(1.-EPSP)
0315             IF(EPSP.GT.1.E-4) THEN
0316               RLN=LOG((1.+ROOT)/(1.-ROOT))
0317             ELSE
0318               RLN=LOG(4./EPSP-2.)
0319             ENDIF
0320             PHIREP=0.25*(RLN**2-PARU(1)**2)
0321             PHIIMP=0.5*PARU(1)*RLN
0322             PSIREP=-(1.+0.5*ROOT*RLN)
0323             PSIIMP=0.5*PARU(1)*ROOT
0324           ELSE
0325             PHIREP=-(ASIN(1./SQRT(EPSP)))**2
0326             PHIIMP=0.
0327             PSIREP=-(1.+SQRT(EPSP-1.)*ASIN(1./SQRT(EPSP)))
0328             PSIIMP=0.
0329           ENDIF
0330           FXYRE=EPS*EPSP/(8.*(EPS-EPSP))*(1.-EPS*EPSP/(EPS-EPSP)*(PHIRE-
0331      &    PHIREP)+2.*EPS/(EPS-EPSP)*(PSIRE-PSIREP))
0332           FXYIM=EPS*EPSP/(8.*(EPS-EPSP))*(-EPS*EPSP/(EPS-EPSP)*(PHIIM-
0333      &    PHIIMP)+2.*EPS/(EPS-EPSP)*(PSIIM-PSIIMP))
0334           F1RE=EPS*EPSP/(2.*(EPS-EPSP))*(PHIRE-PHIREP)
0335           F1IM=EPS*EPSP/(2.*(EPS-EPSP))*(PHIIM-PHIIMP)
0336           IF(J.LE.2*MSTP(1)) THEN
0337             ETARE=ETARE-3.*EJ*VJ*(FXYRE-0.25*F1RE)
0338             ETAIM=ETAIM-3.*EJ*VJ*(FXYIM-0.25*F1IM)
0339           ELSEIF(J.LE.3*MSTP(1)) THEN
0340             ETARE=ETARE-EJ*VJ*(FXYRE-0.25*F1RE)
0341             ETAIM=ETAIM-EJ*VJ*(FXYIM-0.25*F1IM)
0342           ELSE
0343             ETARE=ETARE-SQRT(1.-XW)*(((1.+2./EPS)*XW/SQRT(1.-XW)-
0344      &      (5.+2./EPS))*FXYRE+(3.-XW/SQRT(1.-XW))*F1RE)
0345             ETAIM=ETAIM-SQRT(1.-XW)*(((1.+2./EPS)*XW/SQRT(1.-XW)-
0346      &      (5.+2./EPS))*FXYIM+(3.-XW/SQRT(1.-XW))*F1IM)
0347           ENDIF
0348   160     CONTINUE
0349           ETA2=ETARE**2+ETAIM**2
0350           WDTP(I)=(AEM/PARU(1))**2*(1.-(PMAS(23,1)/RMAS)**2)**3/XW*ETA2
0351           WID2=WIDS(23,2)
0352         ELSE
0353 C...H0 -> Z0 + Z0, W+ + W-
0354           WDTP(I)=(1.-4.*RM1+12.*RM1**2)*SQRT(MAX(0.,1.-4.*RM1))/
0355      &    (2.*(18-I))
0356           WID2=WIDS(7+I,1)
0357         ENDIF
0358         WDTP(0)=WDTP(0)+WDTP(I)
0359         IF(MDME(IDC,1).GT.0) THEN
0360           WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
0361           WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
0362           WDTE(I,0)=WDTE(I,MDME(IDC,1))
0363           WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
0364         ENDIF
0365   170   CONTINUE
0366
0367       ELSEIF(KFLA.EQ.32) THEN
0368 C...Z'0:
0369         IF(MINT(61).EQ.1) THEN
0370           EI=KCHG(IABS(MINT(15)),1)/3.
0371           AI=SIGN(1.,EI)
0372           VI=AI-4.*EI*XW
0373           SQMZ=PMAS(23,1)**2
0374           GZMZ=PMAS(23,2)*PMAS(23,1)
0375           API=SIGN(1.,EI)
0376           VPI=API-4.*EI*XW
0377           SQMZP=PMAS(32,1)**2
0378           GZPMZP=PMAS(32,2)*PMAS(32,1)
0379           GGI=EI**2
0380           GZI=EI*VI/(8.*XW*(1.-XW))*SQM*(SQM-SQMZ)/
0381      &    ((SQM-SQMZ)**2+GZMZ**2)
0382           GZPI=EI*VPI/(8.*XW*(1.-XW))*SQM*(SQM-SQMZP)/
0383      &    ((SQM-SQMZP)**2+GZPMZP**2)
0384           ZZI=(VI**2+AI**2)/(16.*XW*(1.-XW))**2*SQM**2/
0385      &    ((SQM-SQMZ)**2+GZMZ**2)
0386           ZZPI=2.*(VI*VPI+AI*API)/(16.*XW*(1.-XW))**2*
0387      &    SQM**2*((SQM-SQMZ)*(SQM-SQMZP)+GZMZ*GZPMZP)/
0388      &    (((SQM-SQMZ)**2+GZMZ**2)*((SQM-SQMZP)**2+GZPMZP**2))
0389           ZPZPI=(VPI**2+API**2)/(16.*XW*(1.-XW))**2*SQM**2/
0390      &    ((SQM-SQMZP)**2+GZPMZP**2)
0391           IF(MSTP(44).EQ.1) THEN
0392 C...Only gamma* production included
0393             GZI=0.
0394             GZPI=0.
0395             ZZI=0.
0396             ZZPI=0.
0397             ZPZPI=0.
0398           ELSEIF(MSTP(44).EQ.2) THEN
0399 C...Only Z0 production included
0400             GGI=0.
0401             GZI=0.
0402             GZPI=0.
0403             ZZPI=0.
0404             ZPZPI=0.
0405           ELSEIF(MSTP(44).EQ.3) THEN
0406 C...Only Z'0 production included
0407             GGI=0.
0408             GZI=0.
0409             GZPI=0.
0410             ZZI=0.
0411             ZZPI=0.
0412           ELSEIF(MSTP(44).EQ.4) THEN
0413 C...Only gamma*/Z0 production included
0414             GZPI=0.
0415             ZZPI=0.
0416             ZPZPI=0.
0417           ELSEIF(MSTP(44).EQ.5) THEN
0418 C...Only gamma*/Z'0 production included
0419             GZI=0.
0420             ZZI=0.
0421             ZZPI=0.
0422           ELSEIF(MSTP(44).EQ.6) THEN
0423 C...Only Z0/Z'0 production included
0424             GGI=0.
0425             GZI=0.
0426             GZPI=0.
0427           ENDIF
0428         ELSEIF(MINT(61).EQ.2) THEN
0429           VINT(111)=0.
0430           VINT(112)=0.
0431           VINT(113)=0.
0432           VINT(114)=0.
0433           VINT(115)=0.
0434           VINT(116)=0.
0435         ENDIF
0436         DO 180 I=1,MDCY(32,3)
0437         IDC=I+MDCY(32,2)-1
0438         RM1=(PMAS(IABS(KFDP(IDC,1)),1)/RMAS)**2
0439         RM2=(PMAS(IABS(KFDP(IDC,2)),1)/RMAS)**2
0440         IF(SQRT(RM1)+SQRT(RM2).GT.1..OR.MDME(IDC,1).LT.0) GOTO 180
0441         IF(I.LE.8) THEN
0442 C...Z'0 -> q + qb
0443           EF=KCHG(I,1)/3.
0444           AF=SIGN(1.,EF+0.1)
0445           VF=AF-4.*EF*XW
0446           APF=SIGN(1.,EF+0.1)
0447           VPF=APF-4.*EF*XW
0448           IF(MINT(61).EQ.0) THEN
0449             WDTP(I)=3.*(VPF**2*(1.+2.*RM1)+APF**2*(1.-4.*RM1))*
0450      &      SQRT(MAX(0.,1.-4.*RM1))*RADC
0451           ELSEIF(MINT(61).EQ.1) THEN
0452             WDTP(I)=3.*((GGI*EF**2+GZI*EF*VF+GZPI*EF*VPF+ZZI*VF**2+
0453      &      ZZPI*VF*VPF+ZPZPI*VPF**2)*(1.+2.*RM1)+(ZZI*AF**2+
0454      &      ZZPI*AF*APF+ZPZPI*APF**2)*(1.-4.*RM1))*
0455      &      SQRT(MAX(0.,1.-4.*RM1))*RADC
0456           ELSEIF(MINT(61).EQ.2) THEN
0457             GGF=3.*EF**2*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))*RADC
0458             GZF=3.*EF*VF*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))*RADC
0459             GZPF=3.*EF*VPF*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))*RADC
0460             ZZF=3.*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*
0461      &      SQRT(MAX(0.,1.-4.*RM1))*RADC
0462             ZZPF=3.*(VF*VPF*(1.+2.*RM1)+AF*APF*(1.-4.*RM1))*
0463      &      SQRT(MAX(0.,1.-4.*RM1))*RADC
0464             ZPZPF=3.*(VPF**2*(1.+2.*RM1)+APF**2*(1.-4.*RM1))*
0465      &      SQRT(MAX(0.,1.-4.*RM1))*RADC
0466           ENDIF
0467           WID2=1.
0468         ELSE
0469 C...Z'0 -> l+ + l-, nu + nub
0470           EF=KCHG(I+2,1)/3.
0471           AF=SIGN(1.,EF+0.1)
0472           VF=AF-4.*EF*XW
0473           APF=SIGN(1.,EF+0.1)
0474           VPF=API-4.*EF*XW
0475           IF(MINT(61).EQ.0) THEN
0476             WDTP(I)=(VPF**2*(1.+2.*RM1)+APF**2*(1.-4.*RM1))*
0477      &      SQRT(MAX(0.,1.-4.*RM1))
0478           ELSEIF(MINT(61).EQ.1) THEN
0479             WDTP(I)=((GGI*EF**2+GZI*EF*VF+GZPI*EF*VPF+ZZI*VF**2+
0480      &      ZZPI*VF*VPF+ZPZPI*VPF**2)*(1.+2.*RM1)+(ZZI*AF**2+
0481      &      ZZPI*AF*APF+ZPZPI*APF**2)*(1.-4.*RM1))*
0482      &      SQRT(MAX(0.,1.-4.*RM1))
0483           ELSEIF(MINT(61).EQ.2) THEN
0484             GGF=EF**2*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))
0485             GZF=EF*VF*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))
0486             GZPF=EF*VPF*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))
0487             ZZF=(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*
0488      &      SQRT(MAX(0.,1.-4.*RM1))
0489             ZZPF=(VF*VPF*(1.+2.*RM1)+AF*APF*(1.-4.*RM1))*
0490      &      SQRT(MAX(0.,1.-4.*RM1))
0491             ZPZPF=(VPF**2*(1.+2.*RM1)+APF**2*(1.-4.*RM1))*
0492      &      SQRT(MAX(0.,1.-4.*RM1))
0493           ENDIF
0494           WID2=1.
0495         ENDIF
0496         WDTP(0)=WDTP(0)+WDTP(I)
0497         IF(MDME(IDC,1).GT.0) THEN
0498           WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
0499           WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
0500           WDTE(I,0)=WDTE(I,MDME(IDC,1))
0501           WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
0502           VINT(111)=VINT(111)+GGF
0503           VINT(112)=VINT(112)+GZF
0504           VINT(113)=VINT(113)+GZPF
0505           VINT(114)=VINT(114)+ZZF
0506           VINT(115)=VINT(115)+ZZPF
0507           VINT(116)=VINT(116)+ZPZPF
0508         ENDIF
0509   180   CONTINUE
0510         IF(MSTP(44).EQ.1) THEN
0511 C...Only gamma* production included
0512           VINT(112)=0.
0513           VINT(113)=0.
0514           VINT(114)=0.
0515           VINT(115)=0.
0516           VINT(116)=0.
0517         ELSEIF(MSTP(44).EQ.2) THEN
0518 C...Only Z0 production included
0519           VINT(111)=0.
0520           VINT(112)=0.
0521           VINT(113)=0.
0522           VINT(115)=0.
0523           VINT(116)=0.
0524         ELSEIF(MSTP(44).EQ.3) THEN
0525 C...Only Z'0 production included
0526           VINT(111)=0.
0527           VINT(112)=0.
0528           VINT(113)=0.
0529           VINT(114)=0.
0530           VINT(115)=0.
0531         ELSEIF(MSTP(44).EQ.4) THEN
0532 C...Only gamma*/Z0 production included
0533           VINT(113)=0.
0534           VINT(115)=0.
0535           VINT(116)=0.
0536         ELSEIF(MSTP(44).EQ.5) THEN
0537 C...Only gamma*/Z'0 production included
0538           VINT(112)=0.
0539           VINT(114)=0.
0540           VINT(115)=0.
0541         ELSEIF(MSTP(44).EQ.6) THEN
0542 C...Only Z0/Z'0 production included
0543           VINT(111)=0.
0544           VINT(112)=0.
0545           VINT(113)=0.
0546         ENDIF
0547
0548       ELSEIF(KFLA.EQ.37) THEN
0549 C...H+/-:
0550         DO 190 I=1,MDCY(37,3)
0551         IDC=I+MDCY(37,2)-1
0552         RM1=(PMAS(IABS(KFDP(IDC,1)),1)/RMAS)**2
0553         RM2=(PMAS(IABS(KFDP(IDC,2)),1)/RMAS)**2
0554         IF(SQRT(RM1)+SQRT(RM2).GT.1..OR.MDME(IDC,1).LT.0) GOTO 190
0555         IF(I.LE.4) THEN
0556 C...H+/- -> q + qb'
0557           WDTP(I)=3.*((RM1*PARU(121)+RM2/PARU(121))*
0558      &    (1.-RM1-RM2)-4.*RM1*RM2)*
0559      &    SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))*RADC
0560           WID2=1.
0561         ELSE
0562 C...H+/- -> l+/- + nu
0563           WDTP(I)=((RM1*PARU(121)+RM2/PARU(121))*
0564      &    (1.-RM1-RM2)-4.*RM1*RM2)*
0565      &    SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))
0566           WID2=1.
0567         ENDIF
0568         WDTP(0)=WDTP(0)+WDTP(I)
0569         IF(MDME(IDC,1).GT.0) THEN
0570           WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
0571           WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
0572           WDTE(I,0)=WDTE(I,MDME(IDC,1))
0573           WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
0574         ENDIF
0575   190   CONTINUE
0576
0577       ELSEIF(KFLA.EQ.40) THEN
0578 C...R:
0579         DO 200 I=1,MDCY(40,3)
0580         IDC=I+MDCY(40,2)-1
0581         RM1=(PMAS(IABS(KFDP(IDC,1)),1)/RMAS)**2
0582         RM2=(PMAS(IABS(KFDP(IDC,2)),1)/RMAS)**2
0583         IF(SQRT(RM1)+SQRT(RM2).GT.1..OR.MDME(IDC,1).LT.0) GOTO 200
0584         IF(I.LE.4) THEN
0585 C...R -> q + qb'
0586           WDTP(I)=3.*RADC
0587           WID2=1.
0588         ELSE
0589 C...R -> l+ + l'-
0590           WDTP(I)=1.
0591           WID2=1.
0592         ENDIF
0593         WDTP(0)=WDTP(0)+WDTP(I)
0594         IF(MDME(IDC,1).GT.0) THEN
0595           WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
0596           WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
0597           WDTE(I,0)=WDTE(I,MDME(IDC,1))
0598           WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
0599         ENDIF
0600   200   CONTINUE
0601
0602       ENDIF
0603       MINT(61)=0
0604
0605       RETURN
0606       END