pythiaeRHIC/pythia/pywidt.f

0001
0002 C*********************************************************************
0003
0004 C...PYWIDT
0005 C...Calculates full and partial widths of resonances.
0006
0007       SUBROUTINE PYWIDT(KFLR,SH,WDTP,WDTE)
0008
0009 C...Double precision and integer declarations.
0010       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0011       IMPLICIT INTEGER(I-N)
0012       INTEGER PYK,PYCHGE,PYCOMP
0013 C...Parameter statement to help give large particle numbers.
0014       PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000,
0015      &KEXCIT=4000000,KDIMEN=5000000)
0016 C...Commonblocks.
0017       COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0018       COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
0019       COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5)
0020       COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200)
0021       COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
0022       COMMON/PYINT1/MINT(400),VINT(400)
0023       COMMON/PYINT4/MWID(500),WIDS(500,5)
0024       COMMON/PYMSSM/IMSS(0:99),RMSS(0:99)
0025       COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2),
0026      &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2)
0027       COMMON/PYTCSM/ITCM(0:99),RTCM(0:99)
0028       SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/,
0029      &/PYINT4/,/PYMSSM/,/PYSSMT/,/PYTCSM/
0030 C...Local arrays and saved variables.
0031       COMPLEX*16 ZMIXC(4,4),AL,BL,AR,BR,FL,FR
0032       DIMENSION WDTP(0:400),WDTE(0:400,0:5),MOFSV(3,2),WIDWSV(3,2),
0033      &WID2SV(3,2),WDTPP(0:400),WDTEP(0:400,0:5)
0034       SAVE MOFSV,WIDWSV,WID2SV
0035       DATA MOFSV/6*0/,WIDWSV/6*0D0/,WID2SV/6*0D0/
0036
0037 C...Compressed code and sign; mass.
0038       KFLA=IABS(KFLR)
0039       KFLS=ISIGN(1,KFLR)
0040       KC=PYCOMP(KFLA)
0041       SHR=SQRT(SH)
0042       PMR=PMAS(KC,1)
0043
0044 C...Reset width information.
0045       DO 110 I=0,MDCY(KC,3)
0046         WDTP(I)=0D0
0047         DO 100 J=0,5
0048           WDTE(I,J)=0D0
0049   100   CONTINUE
0050   110 CONTINUE
0051
0052 C...Allow for fudge factor to rescale resonance width.
0053       FUDGE=1D0
0054       IF(MSTP(110).NE.0.AND.(MWID(KC).EQ.1.OR.MWID(KC).EQ.2.OR.
0055      &(MWID(KC).EQ.3.AND.MINT(63).EQ.1))) THEN
0056         IF(MSTP(110).EQ.KFLA) THEN
0057           FUDGE=PARP(110)
0058         ELSEIF(MSTP(110).EQ.-1) THEN
0059           IF(KFLA.NE.6.AND.KFLA.NE.23.AND.KFLA.NE.24) FUDGE=PARP(110)
0060         ELSEIF(MSTP(110).EQ.-2) THEN
0061           FUDGE=PARP(110)
0062         ENDIF
0063       ENDIF
0064
0065 C...Not to be treated as a resonance: return.
0066       IF((MWID(KC).LE.0.OR.MWID(KC).GE.4).AND.KFLA.NE.21.AND.
0067      &KFLA.NE.22) THEN
0068         WDTP(0)=1D0
0069         WDTE(0,0)=1D0
0070         MINT(61)=0
0071         MINT(62)=0
0072         MINT(63)=0
0073         RETURN
0074
0075 C...Treatment as a resonance based on tabulated branching ratios.
0076       ELSEIF(MWID(KC).EQ.2.OR.(MWID(KC).EQ.3.AND.MINT(63).EQ.0)) THEN
0077 C...Loop over possible decay channels; skip irrelevant ones.
0078         DO 120 I=1,MDCY(KC,3)
0079           IDC=I+MDCY(KC,2)-1
0080           IF(MDME(IDC,1).LT.0) GOTO 120
0081
0082 C...Read out decay products and nominal masses.
0083           KFD1=KFDP(IDC,1)
0084           KFC1=PYCOMP(KFD1)
0085           IF(KCHG(KFC1,3).EQ.1) KFD1=KFLS*KFD1
0086           PM1=PMAS(KFC1,1)
0087           KFD2=KFDP(IDC,2)
0088           KFC2=PYCOMP(KFD2)
0089           IF(KCHG(KFC2,3).EQ.1) KFD2=KFLS*KFD2
0090           PM2=PMAS(KFC2,1)
0091           KFD3=KFDP(IDC,3)
0092           PM3=0D0
0093           IF(KFD3.NE.0) THEN
0094             KFC3=PYCOMP(KFD3)
0095             IF(KCHG(KFC3,3).EQ.1) KFD3=KFLS*KFD3
0096             PM3=PMAS(KFC3,1)
0097           ENDIF
0098
0099 C...Naive partial width and alternative threshold factors.
0100           WDTP(I)=PMAS(KC,2)*BRAT(IDC)*(SHR/PMR)
0101           IF(MDME(IDC,2).GE.51.AND.MDME(IDC,2).LE.53.AND.
0102      &    PM1+PM2+PM3.GE.SHR) THEN
0103              WDTP(I)=0D0
0104           ELSEIF(MDME(IDC,2).EQ.52.AND.KFD3.EQ.0) THEN
0105             WDTP(I)=WDTP(I)*SQRT(MAX(0D0,(SH-PM1**2-PM2**2)**2-
0106      &      4D0*PM1**2*PM2**2))/SH
0107           ELSEIF(MDME(IDC,2).EQ.52) THEN
0108             PMA=MAX(PM1,PM2,PM3)
0109             PMC=MIN(PM1,PM2,PM3)
0110             PMB=PM1+PM2+PM3-PMA-PMC
0111             PMBC=PMB+PMC+0.5D0*(SHR-PMA-PMC-PMC)
0112             PMAN=PMA**2/SH
0113             PMBN=PMB**2/SH
0114             PMCN=PMC**2/SH
0115             PMBCN=PMBC**2/SH
0116             WDTP(I)=WDTP(I)*SQRT(MAX(0D0,
0117      &      ((1D0-PMAN-PMBCN)**2-4D0*PMAN*PMBCN)*
0118      &      ((PMBCN-PMBN-PMCN)**2-4D0*PMBN*PMCN)))*
0119      &      ((SHR-PMA)**2-(PMB+PMC)**2)*
0120      &      (1D0+0.25D0*(PMA+PMB+PMC)/SHR)/
0121      &      ((1D0-PMBCN)*PMBCN*SH)
0122           ELSEIF(MDME(IDC,2).EQ.53.AND.KFD3.EQ.0) THEN
0123             WDTP(I)=WDTP(I)*SQRT(
0124      &      MAX(0D0,(SH-PM1**2-PM2**2)**2-4D0*PM1**2*PM2**2)/
0125      &      MAX(1D-4,(PMR**2-PM1**2-PM2**2)**2-4D0*PM1**2*PM2**2))
0126           ELSEIF(MDME(IDC,2).EQ.53) THEN
0127             PMA=MAX(PM1,PM2,PM3)
0128             PMC=MIN(PM1,PM2,PM3)
0129             PMB=PM1+PM2+PM3-PMA-PMC
0130             PMBC=PMB+PMC+0.5D0*(SHR-PMA-PMB-PMC)
0131             PMAN=PMA**2/SH
0132             PMBN=PMB**2/SH
0133             PMCN=PMC**2/SH
0134             PMBCN=PMBC**2/SH
0135             FACACT=SQRT(MAX(0D0,
0136      &      ((1D0-PMAN-PMBCN)**2-4D0*PMAN*PMBCN)*
0137      &      ((PMBCN-PMBN-PMCN)**2-4D0*PMBN*PMCN)))*
0138      &      ((SHR-PMA)**2-(PMB+PMC)**2)*
0139      &      (1D0+0.25D0*(PMA+PMB+PMC)/SHR)/
0140      &      ((1D0-PMBCN)*PMBCN*SH)
0141             PMBC=PMB+PMC+0.5D0*(PMR-PMA-PMB-PMC)
0142             PMAN=PMA**2/PMR**2
0143             PMBN=PMB**2/PMR**2
0144             PMCN=PMC**2/PMR**2
0145             PMBCN=PMBC**2/PMR**2
0146             FACNOM=SQRT(MAX(0D0,
0147      &      ((1D0-PMAN-PMBCN)**2-4D0*PMAN*PMBCN)*
0148      &      ((PMBCN-PMBN-PMCN)**2-4D0*PMBN*PMCN)))*
0149      &      ((PMR-PMA)**2-(PMB+PMC)**2)*
0150      &      (1D0+0.25D0*(PMA+PMB+PMC)/PMR)/
0151      &      ((1D0-PMBCN)*PMBCN*PMR**2)
0152             WDTP(I)=WDTP(I)*FACACT/MAX(1D-6,FACNOM)
0153           ENDIF
0154           WDTP(I)=FUDGE*WDTP(I)
0155           WDTP(0)=WDTP(0)+WDTP(I)
0156
0157 C...Calculate secondary width (at most two identical/opposite).
0158           WID2=1D0
0159           IF(MDME(IDC,1).GT.0) THEN
0160             IF(KFD2.EQ.KFD1) THEN
0161               IF(KCHG(KFC1,3).EQ.0) THEN
0162                 WID2=WIDS(KFC1,1)
0163               ELSEIF(KFD1.GT.0) THEN
0164                 WID2=WIDS(KFC1,4)
0165               ELSE
0166                 WID2=WIDS(KFC1,5)
0167               ENDIF
0168               IF(KFD3.GT.0) THEN
0169                 WID2=WID2*WIDS(KFC3,2)
0170               ELSEIF(KFD3.LT.0) THEN
0171                 WID2=WID2*WIDS(KFC3,3)
0172               ENDIF
0173             ELSEIF(KFD2.EQ.-KFD1) THEN
0174               WID2=WIDS(KFC1,1)
0175               IF(KFD3.GT.0) THEN
0176                 WID2=WID2*WIDS(KFC3,2)
0177               ELSEIF(KFD3.LT.0) THEN
0178                 WID2=WID2*WIDS(KFC3,3)
0179               ENDIF
0180             ELSEIF(KFD3.EQ.KFD1) THEN
0181               IF(KCHG(KFC1,3).EQ.0) THEN
0182                 WID2=WIDS(KFC1,1)
0183               ELSEIF(KFD1.GT.0) THEN
0184                 WID2=WIDS(KFC1,4)
0185               ELSE
0186                 WID2=WIDS(KFC1,5)
0187               ENDIF
0188               IF(KFD2.GT.0) THEN
0189                 WID2=WID2*WIDS(KFC2,2)
0190               ELSEIF(KFD2.LT.0) THEN
0191                 WID2=WID2*WIDS(KFC2,3)
0192               ENDIF
0193             ELSEIF(KFD3.EQ.-KFD1) THEN
0194               WID2=WIDS(KFC1,1)
0195               IF(KFD2.GT.0) THEN
0196                 WID2=WID2*WIDS(KFC2,2)
0197               ELSEIF(KFD2.LT.0) THEN
0198                 WID2=WID2*WIDS(KFC2,3)
0199               ENDIF
0200             ELSEIF(KFD3.EQ.KFD2) THEN
0201               IF(KCHG(KFC2,3).EQ.0) THEN
0202                 WID2=WIDS(KFC2,1)
0203               ELSEIF(KFD2.GT.0) THEN
0204                 WID2=WIDS(KFC2,4)
0205               ELSE
0206                 WID2=WIDS(KFC2,5)
0207               ENDIF
0208               IF(KFD1.GT.0) THEN
0209                 WID2=WID2*WIDS(KFC1,2)
0210               ELSEIF(KFD1.LT.0) THEN
0211                 WID2=WID2*WIDS(KFC1,3)
0212               ENDIF
0213             ELSEIF(KFD3.EQ.-KFD2) THEN
0214               WID2=WIDS(KFC2,1)
0215               IF(KFD1.GT.0) THEN
0216                 WID2=WID2*WIDS(KFC1,2)
0217               ELSEIF(KFD1.LT.0) THEN
0218                 WID2=WID2*WIDS(KFC1,3)
0219               ENDIF
0220             ELSE
0221               IF(KFD1.GT.0) THEN
0222                 WID2=WIDS(KFC1,2)
0223               ELSE
0224                 WID2=WIDS(KFC1,3)
0225               ENDIF
0226               IF(KFD2.GT.0) THEN
0227                 WID2=WID2*WIDS(KFC2,2)
0228               ELSE
0229                 WID2=WID2*WIDS(KFC2,3)
0230               ENDIF
0231               IF(KFD3.GT.0) THEN
0232                 WID2=WID2*WIDS(KFC3,2)
0233               ELSEIF(KFD3.LT.0) THEN
0234                 WID2=WID2*WIDS(KFC3,3)
0235               ENDIF
0236             ENDIF
0237
0238 C...Store effective widths according to case.
0239             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
0240             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
0241             WDTE(I,0)=WDTE(I,MDME(IDC,1))
0242             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
0243           ENDIF
0244   120   CONTINUE
0245 C...Return.
0246         MINT(61)=0
0247         MINT(62)=0
0248         MINT(63)=0
0249         RETURN
0250       ENDIF
0251
0252 C...Here begins detailed dynamical calculation of resonance widths.
0253 C...Shared treatment of Higgs states.
0254       KFHIGG=25
0255       IHIGG=1
0256       IF(KFLA.EQ.35.OR.KFLA.EQ.36) THEN
0257         KFHIGG=KFLA
0258         IHIGG=KFLA-33
0259       ENDIF
0260
0261 C...Common electroweak and strong constants.
0262       XW=PARU(102)
0263       XWV=XW
0264       IF(MSTP(8).GE.2) XW=1D0-(PMAS(24,1)/PMAS(23,1))**2
0265       XW1=1D0-XW
0266       AEM=PYALEM(SH)
0267       IF(MSTP(8).GE.1) AEM=SQRT(2D0)*PARU(105)*PMAS(24,1)**2*XW/PARU(1)
0268       AS=PYALPS(SH)
0269       RADC=1D0+AS/PARU(1)
0270
0271       IF(KFLA.EQ.6) THEN
0272 C...t quark.
0273         FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR
0274         RADCT=1D0-2.5D0*AS/PARU(1)
0275         DO 140 I=1,MDCY(KC,3)
0276           IDC=I+MDCY(KC,2)-1
0277           IF(MDME(IDC,1).LT.0) GOTO 140
0278           RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
0279           RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
0280           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 140
0281           WID2=1D0
0282           IF(I.GE.4.AND.I.LE.7) THEN
0283 C...t -> W + q; including approximate QCD correction factor.
0284             WDTP(I)=FAC*VCKM(3,I-3)*RADCT*
0285      &      SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))*
0286      &      ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2)
0287             IF(KFLR.GT.0) THEN
0288               WID2=WIDS(24,2)
0289               IF(I.EQ.7) WID2=WID2*WIDS(7,2)
0290             ELSE
0291               WID2=WIDS(24,3)
0292               IF(I.EQ.7) WID2=WID2*WIDS(7,3)
0293             ENDIF
0294           ELSEIF(I.EQ.9) THEN
0295 C...t -> H + b.
0296             RM2R=PYMRUN(KFDP(IDC,2),SH)**2/SH
0297             WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))*
0298      &      ((1D0+RM2-RM1)*(RM2R*PARU(141)**2+1D0/PARU(141)**2)+
0299      &      4D0*SQRT(RM2R*RM2))
0300             WID2=WIDS(37,2)
0301             IF(KFLR.LT.0) WID2=WIDS(37,3)
0302 CMRENNA++
0303           ELSEIF(I.GE.10.AND.I.LE.13.AND.IMSS(1).NE.0) THEN
0304 C...t -> ~t + ~chi_i0, i = 1, 2, 3 or 4.
0305             BETA=ATAN(RMSS(5))
0306             SINB=SIN(BETA)
0307             TANW=SQRT(PARU(102)/(1D0-PARU(102)))
0308             ET=KCHG(6,1)/3D0
0309             T3L=SIGN(0.5D0,ET)
0310             KFC1=PYCOMP(KFDP(IDC,1))
0311             KFC2=PYCOMP(KFDP(IDC,2))
0312             PMNCHI=PMAS(KFC1,1)
0313             PMSTOP=PMAS(KFC2,1)
0314             IF(SHR.GT.PMNCHI+PMSTOP) THEN
0315               IZ=I-9
0316               DO 130 IK=1,4
0317                 ZMIXC(IZ,IK)=DCMPLX(ZMIX(IZ,IK),ZMIXI(IZ,IK))
0318   130         CONTINUE
0319               AL=SHR*DCONJG(ZMIXC(IZ,4))/(2.0D0*PMAS(24,1)*SINB)
0320               AR=-ET*ZMIXC(IZ,1)*TANW
0321               BL=T3L*(ZMIXC(IZ,2)-ZMIXC(IZ,1)*TANW)-AR
0322               BR=AL
0323               FL=SFMIX(6,1)*AL+SFMIX(6,2)*AR
0324               FR=SFMIX(6,1)*BL+SFMIX(6,2)*BR
0325               PCM=SQRT((SH-(PMNCHI+PMSTOP)**2)*
0326      &        (SH-(PMNCHI-PMSTOP)**2))/(2D0*SHR)
0327               WDTP(I)=(0.5D0*PYALEM(SH)/PARU(102))*PCM*
0328      &        ((ABS(FL)**2+ABS(FR)**2)*(SH+PMNCHI**2-PMSTOP**2)+
0329      &        SMZ(IZ)*4D0*SHR*DBLE(FL*DCONJG(FR)))/SH
0330               IF(KFLR.GT.0) THEN
0331                 WID2=WIDS(KFC1,2)*WIDS(KFC2,2)
0332               ELSE
0333                 WID2=WIDS(KFC1,2)*WIDS(KFC2,3)
0334               ENDIF
0335             ENDIF
0336           ELSEIF(I.EQ.14.AND.IMSS(1).NE.0) THEN
0337 C...t -> ~g + ~t
0338             KFC1=PYCOMP(KFDP(IDC,1))
0339             KFC2=PYCOMP(KFDP(IDC,2))
0340             PMNCHI=PMAS(KFC1,1)
0341             PMSTOP=PMAS(KFC2,1)
0342             IF(SHR.GT.PMNCHI+PMSTOP) THEN
0343               RL=SFMIX(6,1)
0344               RR=-SFMIX(6,2)
0345               PCM=SQRT((SH-(PMNCHI+PMSTOP)**2)*
0346      &        (SH-(PMNCHI-PMSTOP)**2))/(2D0*SHR)
0347               WDTP(I)=4D0/3D0*0.5D0*PYALPS(SH)*PCM*((RL**2+RR**2)*
0348      &        (SH+PMNCHI**2-PMSTOP**2)+PMNCHI*4D0*SHR*RL*RR)/SH
0349               IF(KFLR.GT.0) THEN
0350                 WID2=WIDS(KFC1,2)*WIDS(KFC2,2)
0351               ELSE
0352                 WID2=WIDS(KFC1,2)*WIDS(KFC2,3)
0353               ENDIF
0354             ENDIF
0355           ELSEIF(I.EQ.15.AND.IMSS(1).NE.0) THEN
0356 C...t -> ~gravitino + ~t
0357             XMP2=RMSS(29)**2
0358             KFC1=PYCOMP(KFDP(IDC,1))
0359             XMGR2=PMAS(KFC1,1)**2
0360             WDTP(I)=SH**2*SHR/(96D0*PARU(1)*XMP2*XMGR2)*(1D0-RM2)**4
0361             KFC2=PYCOMP(KFDP(IDC,2))
0362             WID2=WIDS(KFC2,2)
0363             IF(KFLR.LT.0) WID2=WIDS(KFC2,3)
0364 CMRENNA--
0365           ENDIF
0366           WDTP(I)=FUDGE*WDTP(I)
0367           WDTP(0)=WDTP(0)+WDTP(I)
0368           IF(MDME(IDC,1).GT.0) THEN
0369             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
0370             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
0371             WDTE(I,0)=WDTE(I,MDME(IDC,1))
0372             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
0373           ENDIF
0374   140   CONTINUE
0375
0376       ELSEIF(KFLA.EQ.7) THEN
0377 C...b' quark.
0378         FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR
0379         DO 150 I=1,MDCY(KC,3)
0380           IDC=I+MDCY(KC,2)-1
0381           IF(MDME(IDC,1).LT.0) GOTO 150
0382           RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
0383           RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
0384           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 150
0385           WID2=1D0
0386           IF(I.GE.4.AND.I.LE.7) THEN
0387 C...b' -> W + q.
0388             WDTP(I)=FAC*VCKM(I-3,4)*
0389      &      SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))*
0390      &      ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2)
0391             IF(KFLR.GT.0) THEN
0392               WID2=WIDS(24,3)
0393               IF(I.EQ.6) WID2=WID2*WIDS(6,2)
0394               IF(I.EQ.7) WID2=WID2*WIDS(8,2)
0395             ELSE
0396               WID2=WIDS(24,2)
0397               IF(I.EQ.6) WID2=WID2*WIDS(6,3)
0398               IF(I.EQ.7) WID2=WID2*WIDS(8,3)
0399             ENDIF
0400             WID2=WIDS(24,3)
0401             IF(KFLR.LT.0) WID2=WIDS(24,2)
0402           ELSEIF(I.EQ.9.OR.I.EQ.10) THEN
0403 C...b' -> H + q.
0404             WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))*
0405      &      ((1D0+RM2-RM1)*(PARU(141)**2+RM2/PARU(141)**2)+4D0*RM2)
0406             IF(KFLR.GT.0) THEN
0407               WID2=WIDS(37,3)
0408               IF(I.EQ.10) WID2=WID2*WIDS(6,2)
0409             ELSE
0410               WID2=WIDS(37,2)
0411               IF(I.EQ.10) WID2=WID2*WIDS(6,3)
0412             ENDIF
0413           ENDIF
0414           WDTP(I)=FUDGE*WDTP(I)
0415           WDTP(0)=WDTP(0)+WDTP(I)
0416           IF(MDME(IDC,1).GT.0) THEN
0417             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
0418             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
0419             WDTE(I,0)=WDTE(I,MDME(IDC,1))
0420             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
0421           ENDIF
0422   150   CONTINUE
0423
0424       ELSEIF(KFLA.EQ.8) THEN
0425 C...t' quark.
0426         FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR
0427         DO 160 I=1,MDCY(KC,3)
0428           IDC=I+MDCY(KC,2)-1
0429           IF(MDME(IDC,1).LT.0) GOTO 160
0430           RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
0431           RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
0432           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 160
0433           WID2=1D0
0434           IF(I.GE.4.AND.I.LE.7) THEN
0435 C...t' -> W + q.
0436             WDTP(I)=FAC*VCKM(4,I-3)*
0437      &      SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))*
0438      &      ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2)
0439             IF(KFLR.GT.0) THEN
0440               WID2=WIDS(24,2)
0441               IF(I.EQ.7) WID2=WID2*WIDS(7,2)
0442             ELSE
0443               WID2=WIDS(24,3)
0444               IF(I.EQ.7) WID2=WID2*WIDS(7,3)
0445             ENDIF
0446           ELSEIF(I.EQ.9.OR.I.EQ.10) THEN
0447 C...t' -> H + q.
0448             WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))*
0449      &      ((1D0+RM2-RM1)*(RM2*PARU(141)**2+1D0/PARU(141)**2)+4D0*RM2)
0450             IF(KFLR.GT.0) THEN
0451               WID2=WIDS(37,2)
0452               IF(I.EQ.10) WID2=WID2*WIDS(7,2)
0453             ELSE
0454               WID2=WIDS(37,3)
0455               IF(I.EQ.10) WID2=WID2*WIDS(7,3)
0456             ENDIF
0457           ENDIF
0458           WDTP(I)=FUDGE*WDTP(I)
0459           WDTP(0)=WDTP(0)+WDTP(I)
0460           IF(MDME(IDC,1).GT.0) THEN
0461             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
0462             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
0463             WDTE(I,0)=WDTE(I,MDME(IDC,1))
0464             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
0465           ENDIF
0466   160   CONTINUE
0467
0468       ELSEIF(KFLA.EQ.17) THEN
0469 C...tau' lepton.
0470         FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR
0471         DO 170 I=1,MDCY(KC,3)
0472           IDC=I+MDCY(KC,2)-1
0473           IF(MDME(IDC,1).LT.0) GOTO 170
0474           RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
0475           RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
0476           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 170
0477           WID2=1D0
0478           IF(I.EQ.3) THEN
0479 C...tau' -> W + nu'_tau.
0480             WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))*
0481      &      ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2)
0482             IF(KFLR.GT.0) THEN
0483               WID2=WIDS(24,3)
0484               WID2=WID2*WIDS(18,2)
0485             ELSE
0486               WID2=WIDS(24,2)
0487               WID2=WID2*WIDS(18,3)
0488             ENDIF
0489           ELSEIF(I.EQ.5) THEN
0490 C...tau' -> H + nu'_tau.
0491             WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))*
0492      &      ((1D0+RM2-RM1)*(PARU(141)**2+RM2/PARU(141)**2)+4D0*RM2)
0493             IF(KFLR.GT.0) THEN
0494               WID2=WIDS(37,3)
0495               WID2=WID2*WIDS(18,2)
0496             ELSE
0497               WID2=WIDS(37,2)
0498               WID2=WID2*WIDS(18,3)
0499             ENDIF
0500           ENDIF
0501           WDTP(I)=FUDGE*WDTP(I)
0502           WDTP(0)=WDTP(0)+WDTP(I)
0503           IF(MDME(IDC,1).GT.0) THEN
0504             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
0505             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
0506             WDTE(I,0)=WDTE(I,MDME(IDC,1))
0507             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
0508           ENDIF
0509   170   CONTINUE
0510
0511       ELSEIF(KFLA.EQ.18) THEN
0512 C...nu'_tau neutrino.
0513         FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR
0514         DO 180 I=1,MDCY(KC,3)
0515           IDC=I+MDCY(KC,2)-1
0516           IF(MDME(IDC,1).LT.0) GOTO 180
0517           RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
0518           RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
0519           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 180
0520           WID2=1D0
0521           IF(I.EQ.2) THEN
0522 C...nu'_tau -> W + tau'.
0523             WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))*
0524      &      ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2)
0525             IF(KFLR.GT.0) THEN
0526               WID2=WIDS(24,2)
0527               WID2=WID2*WIDS(17,2)
0528             ELSE
0529               WID2=WIDS(24,3)
0530               WID2=WID2*WIDS(17,3)
0531             ENDIF
0532           ELSEIF(I.EQ.3) THEN
0533 C...nu'_tau -> H + tau'.
0534             WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))*
0535      &      ((1D0+RM2-RM1)*(RM2*PARU(141)**2+1D0/PARU(141)**2)+4D0*RM2)
0536             IF(KFLR.GT.0) THEN
0537               WID2=WIDS(37,2)
0538               WID2=WID2*WIDS(17,2)
0539             ELSE
0540               WID2=WIDS(37,3)
0541               WID2=WID2*WIDS(17,3)
0542             ENDIF
0543           ENDIF
0544           WDTP(I)=FUDGE*WDTP(I)
0545           WDTP(0)=WDTP(0)+WDTP(I)
0546           IF(MDME(IDC,1).GT.0) THEN
0547             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
0548             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
0549             WDTE(I,0)=WDTE(I,MDME(IDC,1))
0550             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
0551           ENDIF
0552   180   CONTINUE
0553
0554       ELSEIF(KFLA.EQ.21) THEN
0555 C...QCD:
0556 C***Note that widths are not given in dimensional quantities here.
0557         DO 190 I=1,MDCY(KC,3)
0558           IDC=I+MDCY(KC,2)-1
0559           IF(MDME(IDC,1).LT.0) GOTO 190
0560           RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH
0561           RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH
0562           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 190
0563           WID2=1D0
0564           IF(I.LE.8) THEN
0565 C...QCD -> q + qbar
0566             WDTP(I)=(1D0+2D0*RM1)*SQRT(MAX(0D0,1D0-4D0*RM1))
0567             IF(I.EQ.6) WID2=WIDS(6,1)
0568             IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1)
0569           ENDIF
0570           WDTP(I)=FUDGE*WDTP(I)
0571           WDTP(0)=WDTP(0)+WDTP(I)
0572           IF(MDME(IDC,1).GT.0) THEN
0573             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
0574             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
0575             WDTE(I,0)=WDTE(I,MDME(IDC,1))
0576             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
0577           ENDIF
0578   190   CONTINUE
0579
0580       ELSEIF(KFLA.EQ.22) THEN
0581 C...QED photon.
0582 C***Note that widths are not given in dimensional quantities here.
0583         DO 200 I=1,MDCY(KC,3)
0584           IDC=I+MDCY(KC,2)-1
0585           IF(MDME(IDC,1).LT.0) GOTO 200
0586           RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH
0587           RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH
0588           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 200
0589           WID2=1D0
0590           IF(I.LE.8) THEN
0591 C...QED -> q + qbar.
0592             EF=KCHG(I,1)/3D0
0593             FCOF=3D0*RADC
0594             IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF*PYHFTH(SH,SH*RM1,1D0)
0595             WDTP(I)=FCOF*EF**2*(1D0+2D0*RM1)*SQRT(MAX(0D0,1D0-4D0*RM1))
0596             IF(I.EQ.6) WID2=WIDS(6,1)
0597             IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1)
0598           ELSEIF(I.LE.12) THEN
0599 C...QED -> l+ + l-.
0600             EF=KCHG(9+2*(I-8),1)/3D0
0601             WDTP(I)=EF**2*(1D0+2D0*RM1)*SQRT(MAX(0D0,1D0-4D0*RM1))
0602             IF(I.EQ.12) WID2=WIDS(17,1)
0603           ENDIF
0604           WDTP(I)=FUDGE*WDTP(I)
0605           WDTP(0)=WDTP(0)+WDTP(I)
0606           IF(MDME(IDC,1).GT.0) THEN
0607             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
0608             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
0609             WDTE(I,0)=WDTE(I,MDME(IDC,1))
0610             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
0611           ENDIF
0612   200   CONTINUE
0613
0614       ELSEIF(KFLA.EQ.23) THEN
0615 C...Z0:
0616         ICASE=1
0617         XWC=1D0/(16D0*XW*XW1)
0618         FAC=(AEM*XWC/3D0)*SHR
0619   210   CONTINUE
0620         IF(MINT(61).GE.1.AND.ICASE.EQ.2) THEN
0621           VINT(111)=0D0
0622           VINT(112)=0D0
0623           VINT(114)=0D0
0624         ENDIF
0625         IF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN
0626           KFI=IABS(MINT(15))
0627           IF(KFI.GT.20) KFI=IABS(MINT(16))
0628           EI=KCHG(KFI,1)/3D0
0629           AI=SIGN(1D0,EI)
0630           VI=AI-4D0*EI*XWV
0631           SQMZ=PMAS(23,1)**2
0632           HZ=SHR*WDTP(0)
0633           IF(MSTP(43).EQ.1.OR.MSTP(43).EQ.3) VINT(111)=1D0
0634           IF(MSTP(43).EQ.3) VINT(112)=
0635      &    2D0*XWC*SH*(SH-SQMZ)/((SH-SQMZ)**2+HZ**2)
0636           IF(MSTP(43).EQ.2.OR.MSTP(43).EQ.3) VINT(114)=
0637      &    XWC**2*SH**2/((SH-SQMZ)**2+HZ**2)
0638         ENDIF
0639         DO 220 I=1,MDCY(KC,3)
0640           IDC=I+MDCY(KC,2)-1
0641           IF(MDME(IDC,1).LT.0) GOTO 220
0642           RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH
0643           RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH
0644           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 220
0645           WID2=1D0
0646           IF(I.LE.8) THEN
0647 C...Z0 -> q + qbar
0648             EF=KCHG(I,1)/3D0
0649             AF=SIGN(1D0,EF+0.1D0)
0650             VF=AF-4D0*EF*XWV
0651             FCOF=3D0*RADC
0652             IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF*PYHFTH(SH,SH*RM1,1D0)
0653             IF(I.EQ.6) WID2=WIDS(6,1)
0654             IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1)
0655           ELSEIF(I.LE.16) THEN
0656 C...Z0 -> l+ + l-, nu + nubar
0657             EF=KCHG(I+2,1)/3D0
0658             AF=SIGN(1D0,EF+0.1D0)
0659             VF=AF-4D0*EF*XWV
0660             FCOF=1D0
0661             IF((I.EQ.15.OR.I.EQ.16)) WID2=WIDS(2+I,1)
0662           ENDIF
0663           BE34=SQRT(MAX(0D0,1D0-4D0*RM1))
0664           IF(ICASE.EQ.1) THEN
0665             WDTP(I)=FAC*FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))*
0666      &      BE34
0667           ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN
0668             WDTP(I)=FAC*FCOF*((EI**2*VINT(111)*EF**2+EI*VI*VINT(112)*
0669      &      EF*VF+(VI**2+AI**2)*VINT(114)*VF**2)*(1D0+2D0*RM1)+
0670      &      (VI**2+AI**2)*VINT(114)*AF**2*(1D0-4D0*RM1))*BE34
0671           ELSEIF(MINT(61).EQ.2.AND.ICASE.EQ.2) THEN
0672             FGGF=FCOF*EF**2*(1D0+2D0*RM1)*BE34
0673             FGZF=FCOF*EF*VF*(1D0+2D0*RM1)*BE34
0674             FZZF=FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))*BE34
0675           ENDIF
0676           IF(ICASE.EQ.1) WDTP(I)=FUDGE*WDTP(I)
0677           IF(ICASE.EQ.1) WDTP(0)=WDTP(0)+WDTP(I)
0678           IF(MDME(IDC,1).GT.0) THEN
0679             IF((ICASE.EQ.1.AND.MINT(61).NE.1).OR.
0680      &      (ICASE.EQ.2.AND.MINT(61).EQ.1)) THEN
0681               WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
0682               WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+
0683      &        WDTE(I,MDME(IDC,1))
0684               WDTE(I,0)=WDTE(I,MDME(IDC,1))
0685               WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
0686             ENDIF
0687             IF(MINT(61).EQ.2.AND.ICASE.EQ.2) THEN
0688               IF(MSTP(43).EQ.1.OR.MSTP(43).EQ.3) VINT(111)=
0689      &        VINT(111)+FGGF*WID2
0690               IF(MSTP(43).EQ.3) VINT(112)=VINT(112)+FGZF*WID2
0691               IF(MSTP(43).EQ.2.OR.MSTP(43).EQ.3) VINT(114)=
0692      &        VINT(114)+FZZF*WID2
0693             ENDIF
0694           ENDIF
0695   220   CONTINUE
0696         IF(MINT(61).GE.1) ICASE=3-ICASE
0697         IF(ICASE.EQ.2) GOTO 210
0698
0699       ELSEIF(KFLA.EQ.24) THEN
0700 C...W+/-:
0701         FAC=(AEM/(24D0*XW))*SHR
0702         DO 230 I=1,MDCY(KC,3)
0703           IDC=I+MDCY(KC,2)-1
0704           IF(MDME(IDC,1).LT.0) GOTO 230
0705           RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH
0706           RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH
0707           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 230
0708           WID2=1D0
0709           IF(I.LE.16) THEN
0710 C...W+/- -> q + qbar'
0711             FCOF=3D0*RADC*VCKM((I-1)/4+1,MOD(I-1,4)+1)
0712             IF(KFLR.GT.0) THEN
0713               IF(MOD(I,4).EQ.3) WID2=WIDS(6,2)
0714               IF(MOD(I,4).EQ.0) WID2=WIDS(8,2)
0715               IF(I.GE.13) WID2=WID2*WIDS(7,3)
0716             ELSE
0717               IF(MOD(I,4).EQ.3) WID2=WIDS(6,3)
0718               IF(MOD(I,4).EQ.0) WID2=WIDS(8,3)
0719               IF(I.GE.13) WID2=WID2*WIDS(7,2)
0720             ENDIF
0721           ELSEIF(I.LE.20) THEN
0722 C...W+/- -> l+/- + nu
0723             FCOF=1D0
0724             IF(KFLR.GT.0) THEN
0725               IF(I.EQ.20) WID2=WIDS(17,3)*WIDS(18,2)
0726             ELSE
0727               IF(I.EQ.20) WID2=WIDS(17,2)*WIDS(18,3)
0728             ENDIF
0729           ENDIF
0730           WDTP(I)=FAC*FCOF*(2D0-RM1-RM2-(RM1-RM2)**2)*
0731      &    SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))
0732           WDTP(I)=FUDGE*WDTP(I)
0733           WDTP(0)=WDTP(0)+WDTP(I)
0734           IF(MDME(IDC,1).GT.0) THEN
0735             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
0736             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
0737             WDTE(I,0)=WDTE(I,MDME(IDC,1))
0738             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
0739           ENDIF
0740   230   CONTINUE
0741
0742       ELSEIF(KFLA.EQ.25.OR.KFLA.EQ.35.OR.KFLA.EQ.36) THEN
0743 C...h0 (or H0, or A0):
0744         SHFS=SH
0745         FAC=(AEM/(8D0*XW))*(SHFS/PMAS(24,1)**2)*SHR
0746         DO 270 I=1,MDCY(KFHIGG,3)
0747           IDC=I+MDCY(KFHIGG,2)-1
0748           IF(MDME(IDC,1).LT.0) GOTO 270
0749           KFC1=PYCOMP(KFDP(IDC,1))
0750           KFC2=PYCOMP(KFDP(IDC,2))
0751           RM1=PMAS(KFC1,1)**2/SH
0752           RM2=PMAS(KFC2,1)**2/SH
0753           IF(I.NE.16.AND.I.NE.17.AND.SQRT(RM1)+SQRT(RM2).GT.1D0)
0754      &    GOTO 270
0755           WID2=1D0
0756
0757           IF(I.LE.8) THEN
0758 C...h0 -> q + qbar
0759             WDTP(I)=FAC*3D0*(PYMRUN(KFDP(IDC,1),SH)**2/SHFS)*
0760      &      SQRT(MAX(0D0,1D0-4D0*RM1))*RADC
0761 C...A0 behaves like beta, ho and H0 like beta**3.
0762             IF(IHIGG.NE.3) WDTP(I)=WDTP(I)*(1D0-4D0*RM1)
0763             IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN
0764               IF(MOD(I,2).EQ.1) WDTP(I)=WDTP(I)*PARU(151+10*IHIGG)**2
0765               IF(MOD(I,2).EQ.0) WDTP(I)=WDTP(I)*PARU(152+10*IHIGG)**2
0766               IF(IMSS(1).NE.0.AND.KFC1.EQ.5) THEN
0767                 WDTP(I)=WDTP(I)/(1D0+RMSS(41))**2
0768                 IF(IHIGG.NE.3) THEN
0769                   WDTP(I)=WDTP(I)*(1D0+RMSS(41)*PARU(152+10*IHIGG)/
0770      &            PARU(151+10*IHIGG))**2
0771                 ENDIF
0772               ENDIF
0773             ENDIF
0774             IF(I.EQ.6) WID2=WIDS(6,1)
0775             IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1)
0776           ELSEIF(I.LE.12) THEN
0777 C...h0 -> l+ + l-
0778             WDTP(I)=FAC*RM1*SQRT(MAX(0D0,1D0-4D0*RM1))*(SH/SHFS)
0779 C...A0 behaves like beta, ho and H0 like beta**3.
0780             IF(IHIGG.NE.3) WDTP(I)=WDTP(I)*(1D0-4D0*RM1)
0781             IF(MSTP(4).GE.1.OR.IHIGG.GE.2) WDTP(I)=WDTP(I)*
0782      &      PARU(153+10*IHIGG)**2
0783             IF(I.EQ.12) WID2=WIDS(17,1)
0784
0785           ELSEIF(I.EQ.13) THEN
0786 C...h0 -> g + g; quark loop contribution only
0787             ETARE=0D0
0788             ETAIM=0D0
0789             DO 240 J=1,2*MSTP(1)
0790               EPS=(2D0*PMAS(J,1))**2/SH
0791 C...Loop integral; function of eps=4m^2/shat; different for A0.
0792               IF(EPS.LE.1D0) THEN
0793                 IF(EPS.GT.1D-4) THEN
0794                   ROOT=SQRT(1D0-EPS)
0795                   RLN=LOG((1D0+ROOT)/(1D0-ROOT))
0796                 ELSE
0797                   RLN=LOG(4D0/EPS-2D0)
0798                 ENDIF
0799                 PHIRE=-0.25D0*(RLN**2-PARU(1)**2)
0800                 PHIIM=0.5D0*PARU(1)*RLN
0801               ELSE
0802                 PHIRE=(ASIN(1D0/SQRT(EPS)))**2
0803                 PHIIM=0D0
0804               ENDIF
0805               IF(IHIGG.LE.2) THEN
0806                 ETAREJ=-0.5D0*EPS*(1D0+(1D0-EPS)*PHIRE)
0807                 ETAIMJ=-0.5D0*EPS*(1D0-EPS)*PHIIM
0808               ELSE
0809                 ETAREJ=-0.5D0*EPS*PHIRE
0810                 ETAIMJ=-0.5D0*EPS*PHIIM
0811               ENDIF
0812 C...Couplings (=1 for standard model Higgs).
0813               IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN
0814                 IF(MOD(J,2).EQ.1) THEN
0815                   ETAREJ=ETAREJ*PARU(151+10*IHIGG)
0816                   ETAIMJ=ETAIMJ*PARU(151+10*IHIGG)
0817                 ELSE
0818                   ETAREJ=ETAREJ*PARU(152+10*IHIGG)
0819                   ETAIMJ=ETAIMJ*PARU(152+10*IHIGG)
0820                 ENDIF
0821               ENDIF
0822               ETARE=ETARE+ETAREJ
0823               ETAIM=ETAIM+ETAIMJ
0824   240       CONTINUE
0825             ETA2=ETARE**2+ETAIM**2
0826             WDTP(I)=FAC*(AS/PARU(1))**2*ETA2
0827
0828           ELSEIF(I.EQ.14) THEN
0829 C...h0 -> gamma + gamma; quark, lepton, W+- and H+- loop contributions
0830             ETARE=0D0
0831             ETAIM=0D0
0832             JMAX=3*MSTP(1)+1
0833             IF(MSTP(4).GE.1.OR.IHIGG.GE.2) JMAX=JMAX+1
0834             DO 250 J=1,JMAX
0835               IF(J.LE.2*MSTP(1)) THEN
0836                 EJ=KCHG(J,1)/3D0
0837                 EPS=(2D0*PMAS(J,1))**2/SH
0838               ELSEIF(J.LE.3*MSTP(1)) THEN
0839                 JL=2*(J-2*MSTP(1))-1
0840                 EJ=KCHG(10+JL,1)/3D0
0841                 EPS=(2D0*PMAS(10+JL,1))**2/SH
0842               ELSEIF(J.EQ.3*MSTP(1)+1) THEN
0843                 EPS=(2D0*PMAS(24,1))**2/SH
0844               ELSE
0845                 EPS=(2D0*PMAS(37,1))**2/SH
0846               ENDIF
0847 C...Loop integral; function of eps=4m^2/shat.
0848               IF(EPS.LE.1D0) THEN
0849                 IF(EPS.GT.1D-4) THEN
0850                   ROOT=SQRT(1D0-EPS)
0851                   RLN=LOG((1D0+ROOT)/(1D0-ROOT))
0852                 ELSE
0853                   RLN=LOG(4D0/EPS-2D0)
0854                 ENDIF
0855                 PHIRE=-0.25D0*(RLN**2-PARU(1)**2)
0856                 PHIIM=0.5D0*PARU(1)*RLN
0857               ELSE
0858                 PHIRE=(ASIN(1D0/SQRT(EPS)))**2
0859                 PHIIM=0D0
0860               ENDIF
0861               IF(J.LE.3*MSTP(1)) THEN
0862 C...Fermion loops: loop integral different for A0; charges.
0863                 IF(IHIGG.LE.2) THEN
0864                   PHIPRE=-0.5D0*EPS*(1D0+(1D0-EPS)*PHIRE)
0865                   PHIPIM=-0.5D0*EPS*(1D0-EPS)*PHIIM
0866                 ELSE
0867                   PHIPRE=-0.5D0*EPS*PHIRE
0868                   PHIPIM=-0.5D0*EPS*PHIIM
0869                 ENDIF
0870                 IF(J.LE.2*MSTP(1).AND.MOD(J,2).EQ.1) THEN
0871                   EJC=3D0*EJ**2
0872                   EJH=PARU(151+10*IHIGG)
0873                 ELSEIF(J.LE.2*MSTP(1)) THEN
0874                   EJC=3D0*EJ**2
0875                   EJH=PARU(152+10*IHIGG)
0876                 ELSE
0877                   EJC=EJ**2
0878                   EJH=PARU(153+10*IHIGG)
0879                 ENDIF
0880                 IF(MSTP(4).EQ.0.AND.IHIGG.EQ.1) EJH=1D0
0881                 ETAREJ=EJC*EJH*PHIPRE
0882                 ETAIMJ=EJC*EJH*PHIPIM
0883               ELSEIF(J.EQ.3*MSTP(1)+1) THEN
0884 C...W loops: loop integral and charges.
0885                 ETAREJ=0.5D0+0.75D0*EPS*(1D0+(2D0-EPS)*PHIRE)
0886                 ETAIMJ=0.75D0*EPS*(2D0-EPS)*PHIIM
0887                 IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN
0888                   ETAREJ=ETAREJ*PARU(155+10*IHIGG)
0889                   ETAIMJ=ETAIMJ*PARU(155+10*IHIGG)
0890                 ENDIF
0891               ELSE
0892 C...Charged H loops: loop integral and charges.
0893                 FACHHH=(PMAS(24,1)/PMAS(37,1))**2*
0894      &          PARU(158+10*IHIGG+2*(IHIGG/3))
0895                 ETAREJ=EPS*(1D0-EPS*PHIRE)*FACHHH
0896                 ETAIMJ=-EPS**2*PHIIM*FACHHH
0897               ENDIF
0898               ETARE=ETARE+ETAREJ
0899               ETAIM=ETAIM+ETAIMJ
0900   250       CONTINUE
0901             ETA2=ETARE**2+ETAIM**2
0902             WDTP(I)=FAC*(AEM/PARU(1))**2*0.5D0*ETA2
0903
0904           ELSEIF(I.EQ.15) THEN
0905 C...h0 -> gamma + Z0; quark, lepton, W and H+- loop contributions
0906             ETARE=0D0
0907             ETAIM=0D0
0908             JMAX=3*MSTP(1)+1
0909             IF(MSTP(4).GE.1.OR.IHIGG.GE.2) JMAX=JMAX+1
0910             DO 260 J=1,JMAX
0911               IF(J.LE.2*MSTP(1)) THEN
0912                 EJ=KCHG(J,1)/3D0
0913                 AJ=SIGN(1D0,EJ+0.1D0)
0914                 VJ=AJ-4D0*EJ*XWV
0915                 EPS=(2D0*PMAS(J,1))**2/SH
0916                 EPSP=(2D0*PMAS(J,1)/PMAS(23,1))**2
0917               ELSEIF(J.LE.3*MSTP(1)) THEN
0918                 JL=2*(J-2*MSTP(1))-1
0919                 EJ=KCHG(10+JL,1)/3D0
0920                 AJ=SIGN(1D0,EJ+0.1D0)
0921                 VJ=AJ-4D0*EJ*XWV
0922                 EPS=(2D0*PMAS(10+JL,1))**2/SH
0923                 EPSP=(2D0*PMAS(10+JL,1)/PMAS(23,1))**2
0924               ELSE
0925                 EPS=(2D0*PMAS(24,1))**2/SH
0926                 EPSP=(2D0*PMAS(24,1)/PMAS(23,1))**2
0927               ENDIF
0928 C...Loop integrals; functions of eps=4m^2/shat and eps'=4m^2/m_Z^2.
0929               IF(EPS.LE.1D0) THEN
0930                 ROOT=SQRT(1D0-EPS)
0931                 IF(EPS.GT.1D-4) THEN
0932                   RLN=LOG((1D0+ROOT)/(1D0-ROOT))
0933                 ELSE
0934                   RLN=LOG(4D0/EPS-2D0)
0935                 ENDIF
0936                 PHIRE=-0.25D0*(RLN**2-PARU(1)**2)
0937                 PHIIM=0.5D0*PARU(1)*RLN
0938                 PSIRE=0.5D0*ROOT*RLN
0939                 PSIIM=-0.5D0*ROOT*PARU(1)
0940               ELSE
0941                 PHIRE=(ASIN(1D0/SQRT(EPS)))**2
0942                 PHIIM=0D0
0943                 PSIRE=SQRT(EPS-1D0)*ASIN(1D0/SQRT(EPS))
0944                 PSIIM=0D0
0945               ENDIF
0946               IF(EPSP.LE.1D0) THEN
0947                 ROOT=SQRT(1D0-EPSP)
0948                 IF(EPSP.GT.1D-4) THEN
0949                   RLN=LOG((1D0+ROOT)/(1D0-ROOT))
0950                 ELSE
0951                   RLN=LOG(4D0/EPSP-2D0)
0952                 ENDIF
0953                 PHIREP=-0.25D0*(RLN**2-PARU(1)**2)
0954                 PHIIMP=0.5D0*PARU(1)*RLN
0955                 PSIREP=0.5D0*ROOT*RLN
0956                 PSIIMP=-0.5D0*ROOT*PARU(1)
0957               ELSE
0958                 PHIREP=(ASIN(1D0/SQRT(EPSP)))**2
0959                 PHIIMP=0D0
0960                 PSIREP=SQRT(EPSP-1D0)*ASIN(1D0/SQRT(EPSP))
0961                 PSIIMP=0D0
0962               ENDIF
0963               FXYRE=EPS*EPSP/(8D0*(EPS-EPSP))*(1D0+EPS*EPSP/(EPS-EPSP)*
0964      &        (PHIRE-PHIREP)+2D0*EPS/(EPS-EPSP)*(PSIRE-PSIREP))
0965               FXYIM=EPS**2*EPSP/(8D0*(EPS-EPSP)**2)*
0966      &        (EPSP*(PHIIM-PHIIMP)+2D0*(PSIIM-PSIIMP))
0967               F1RE=-EPS*EPSP/(2D0*(EPS-EPSP))*(PHIRE-PHIREP)
0968               F1IM=-EPS*EPSP/(2D0*(EPS-EPSP))*(PHIIM-PHIIMP)
0969               IF(J.LE.3*MSTP(1)) THEN
0970 C...Fermion loops: loop integral different for A0; charges.
0971                 IF(IHIGG.EQ.3) FXYRE=0D0
0972                 IF(IHIGG.EQ.3) FXYIM=0D0
0973                 IF(J.LE.2*MSTP(1).AND.MOD(J,2).EQ.1) THEN
0974                   EJC=-3D0*EJ*VJ
0975                   EJH=PARU(151+10*IHIGG)
0976                 ELSEIF(J.LE.2*MSTP(1)) THEN
0977                   EJC=-3D0*EJ*VJ
0978                   EJH=PARU(152+10*IHIGG)
0979                 ELSE
0980                   EJC=-EJ*VJ
0981                   EJH=PARU(153+10*IHIGG)
0982                 ENDIF
0983                 IF(MSTP(4).EQ.0.AND.IHIGG.EQ.1) EJH=1D0
0984                 ETAREJ=EJC*EJH*(FXYRE-0.25D0*F1RE)
0985                 ETAIMJ=EJC*EJH*(FXYIM-0.25D0*F1IM)
0986               ELSEIF(J.EQ.3*MSTP(1)+1) THEN
0987 C...W loops: loop integral and charges.
0988                 HEPS=(1D0+2D0/EPS)*XW/XW1-(5D0+2D0/EPS)
0989                 ETAREJ=-XW1*((3D0-XW/XW1)*F1RE+HEPS*FXYRE)
0990                 ETAIMJ=-XW1*((3D0-XW/XW1)*F1IM+HEPS*FXYIM)
0991                 IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN
0992                   ETAREJ=ETAREJ*PARU(155+10*IHIGG)
0993                   ETAIMJ=ETAIMJ*PARU(155+10*IHIGG)
0994                 ENDIF
0995               ELSE
0996 C...Charged H loops: loop integral and charges.
0997                 FACHHH=(PMAS(24,1)/PMAS(37,1))**2*(1D0-2D0*XW)*
0998      &          PARU(158+10*IHIGG+2*(IHIGG/3))
0999                 ETAREJ=FACHHH*FXYRE
1000                 ETAIMJ=FACHHH*FXYIM
1001               ENDIF
1002               ETARE=ETARE+ETAREJ
1003               ETAIM=ETAIM+ETAIMJ
1004   260       CONTINUE
1005             ETA2=(ETARE**2+ETAIM**2)/(XW*XW1)
1006             WDTP(I)=FAC*(AEM/PARU(1))**2*(1D0-PMAS(23,1)**2/SH)**3*ETA2
1007             WID2=WIDS(23,2)
1008
1009           ELSEIF(I.LE.17) THEN
1010 C...h0 -> Z0 + Z0, W+ + W-
1011             PM1=PMAS(IABS(KFDP(IDC,1)),1)
1012             PG1=PMAS(IABS(KFDP(IDC,1)),2)
1013             IF(MINT(62).GE.1) THEN
1014               IF(MSTP(42).EQ.0.OR.(4D0*(PM1+10D0*PG1)**2.LT.SH.AND.
1015      &        CKIN(46).LT.CKIN(45).AND.CKIN(48).LT.CKIN(47).AND.
1016      &        MAX(CKIN(45),CKIN(47)).LT.PM1-10D0*PG1)) THEN
1017                 MOFSV(IHIGG,I-15)=0
1018                 WIDW=(1D0-4D0*RM1+12D0*RM1**2)*SQRT(MAX(0D0,
1019      &          1D0-4D0*RM1))
1020                 WID2=1D0
1021               ELSE
1022                 MOFSV(IHIGG,I-15)=1
1023                 RMAS=SQRT(MAX(0D0,SH))
1024                 CALL PYOFSH(1,KFLA,KFDP(IDC,1),KFDP(IDC,2),RMAS,WIDW,
1025      &          WID2)
1026                 WIDWSV(IHIGG,I-15)=WIDW
1027                 WID2SV(IHIGG,I-15)=WID2
1028               ENDIF
1029             ELSE
1030               IF(MOFSV(IHIGG,I-15).EQ.0) THEN
1031                 WIDW=(1D0-4D0*RM1+12D0*RM1**2)*SQRT(MAX(0D0,
1032      &          1D0-4D0*RM1))
1033                 WID2=1D0
1034               ELSE
1035                 WIDW=WIDWSV(IHIGG,I-15)
1036                 WID2=WID2SV(IHIGG,I-15)
1037               ENDIF
1038             ENDIF
1039             WDTP(I)=FAC*WIDW/(2D0*(18-I))
1040             IF(MSTP(49).NE.0) WDTP(I)=WDTP(I)*PMAS(KFHIGG,1)**2/SHFS
1041             IF(MSTP(4).GE.1.OR.IHIGG.GE.2) WDTP(I)=WDTP(I)*
1042      &      PARU(138+I+10*IHIGG)**2
1043             WID2=WID2*WIDS(7+I,1)
1044
1045           ELSEIF(I.EQ.18.AND.IHIGG.GE.2) THEN
1046 C...H0 -> Z0 + h0, A0-> Z0 + h0
1047             WDTP(I)=FAC*0.5D0*SQRT(MAX(0D0,
1048      &      (1D0-RM1-RM2)**2-4D0*RM1*RM2))**3
1049             IF(IHIGG.EQ.2) THEN
1050              WDTP(I)=WDTP(I)*PARU(179)**2
1051             ELSEIF(IHIGG.EQ.3) THEN
1052              WDTP(I)=WDTP(I)*PARU(186)**2
1053             ENDIF
1054             WID2=WIDS(23,2)*WIDS(25,2)
1055
1056           ELSEIF(I.EQ.19.AND.IHIGG.GE.2) THEN
1057 C...H0 -> h0 + h0, A0-> h0 + h0
1058             WDTP(I)=FAC*0.25D0*
1059      &      PMAS(23,1)**4/SH**2*SQRT(MAX(0D0,1D0-4D0*RM1))
1060             IF(IHIGG.EQ.2) THEN
1061              WDTP(I)=WDTP(I)*PARU(176)**2
1062             ELSEIF(IHIGG.EQ.3) THEN
1063              WDTP(I)=WDTP(I)*PARU(169)**2
1064             ENDIF
1065             WID2=WIDS(25,1)
1066           ELSEIF((I.EQ.20.OR.I.EQ.21).AND.IHIGG.GE.2) THEN
1067 C...H0 -> W+/- + H-/+, A0 -> W+/- + H-/+
1068             WDTP(I)=FAC*0.5D0*SQRT(MAX(0D0,
1069      &      (1D0-RM1-RM2)**2-4D0*RM1*RM2))**3
1070      &      *PARU(195+IHIGG)**2
1071             IF(I.EQ.20) THEN
1072               WID2=WIDS(24,2)*WIDS(37,3)
1073             ELSEIF(I.EQ.21) THEN
1074               WID2=WIDS(24,3)*WIDS(37,2)
1075             ENDIF
1076
1077           ELSEIF(I.EQ.22.AND.IHIGG.EQ.2) THEN
1078 C...H0 -> Z0 + A0.
1079             WDTP(I)=FAC*0.5D0*PARU(187)**2*SQRT(MAX(0D0,
1080      &      (1D0-RM1-RM2)**2-4D0*RM1*RM2))**3
1081             WID2=WIDS(36,2)*WIDS(23,2)
1082
1083           ELSEIF(I.EQ.23.AND.IHIGG.EQ.2) THEN
1084 C...H0 -> h0 + A0.
1085             WDTP(I)=FAC*0.5D0*PARU(180)**2*
1086      &      PMAS(23,1)**4/SH**2*SQRT(MAX(0D0,1D0-4D0*RM1))
1087             WID2=WIDS(25,2)*WIDS(36,2)
1088
1089           ELSEIF(I.EQ.24.AND.IHIGG.EQ.2) THEN
1090 C...H0 -> A0 + A0
1091             WDTP(I)=FAC*0.25D0*PARU(177)**2*
1092      &      PMAS(23,1)**4/SH**2*SQRT(MAX(0D0,1D0-4D0*RM1))
1093             WID2=WIDS(36,1)
1094
1095 CMRENNA++
1096           ELSE
1097 C...Add in SUSY decays (two-body) by rescaling by phase space factor.
1098             RM10=RM1*SH/PMR**2
1099             RM20=RM2*SH/PMR**2
1100             WFAC0=1D0+RM10**2+RM20**2-2D0*(RM10+RM20+RM10*RM20)
1101             WFAC=1D0+RM1**2+RM2**2-2D0*(RM1+RM2+RM1*RM2)
1102             IF(WFAC.LE.0D0 .OR. WFAC0.LE.0D0) THEN
1103               WFAC=0D0
1104             ELSE
1105               WFAC=WFAC/WFAC0
1106             ENDIF
1107             WDTP(I)=PMAS(KFLA,2)*BRAT(IDC)*(SHR/PMR)*SQRT(WFAC)
1108 CMRENNA--
1109             IF(KFC2.EQ.KFC1) THEN
1110               WID2=WIDS(KFC1,1)
1111             ELSE
1112               KSGN1=2
1113               IF(KFDP(IDC,1).LT.0) KSGN1=3
1114               KSGN2=2
1115               IF(KFDP(IDC,2).LT.0) KSGN2=3
1116               WID2=WIDS(KFC1,KSGN1)*WIDS(KFC2,KSGN2)
1117             ENDIF
1118           ENDIF
1119           WDTP(I)=FUDGE*WDTP(I)
1120           WDTP(0)=WDTP(0)+WDTP(I)
1121           IF(MDME(IDC,1).GT.0) THEN
1122             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
1123             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
1124             WDTE(I,0)=WDTE(I,MDME(IDC,1))
1125             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
1126           ENDIF
1127   270   CONTINUE
1128
1129       ELSEIF(KFLA.EQ.32) THEN
1130 C...Z'0:
1131         ICASE=1
1132         XWC=1D0/(16D0*XW*XW1)
1133         FAC=(AEM*XWC/3D0)*SHR
1134         VINT(117)=0D0
1135   280   CONTINUE
1136         IF(MINT(61).GE.1.AND.ICASE.EQ.2) THEN
1137           VINT(111)=0D0
1138           VINT(112)=0D0
1139           VINT(113)=0D0
1140           VINT(114)=0D0
1141           VINT(115)=0D0
1142           VINT(116)=0D0
1143         ENDIF
1144         IF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN
1145           KFAI=IABS(MINT(15))
1146           EI=KCHG(KFAI,1)/3D0
1147           AI=SIGN(1D0,EI+0.1D0)
1148           VI=AI-4D0*EI*XWV
1149           KFAIC=1
1150           IF(KFAI.LE.10.AND.MOD(KFAI,2).EQ.0) KFAIC=2
1151           IF(KFAI.GT.10.AND.MOD(KFAI,2).NE.0) KFAIC=3
1152           IF(KFAI.GT.10.AND.MOD(KFAI,2).EQ.0) KFAIC=4
1153           IF(KFAI.LE.2.OR.KFAI.EQ.11.OR.KFAI.EQ.12) THEN
1154             VPI=PARU(119+2*KFAIC)
1155             API=PARU(120+2*KFAIC)
1156           ELSEIF(KFAI.LE.4.OR.KFAI.EQ.13.OR.KFAI.EQ.14) THEN
1157             VPI=PARJ(178+2*KFAIC)
1158             API=PARJ(179+2*KFAIC)
1159           ELSE
1160             VPI=PARJ(186+2*KFAIC)
1161             API=PARJ(187+2*KFAIC)
1162           ENDIF
1163           SQMZ=PMAS(23,1)**2
1164           HZ=SHR*VINT(117)
1165           SQMZP=PMAS(32,1)**2
1166           HZP=SHR*WDTP(0)
1167           IF(MSTP(44).EQ.1.OR.MSTP(44).EQ.4.OR.MSTP(44).EQ.5.OR.
1168      &    MSTP(44).EQ.7) VINT(111)=1D0
1169           IF(MSTP(44).EQ.4.OR.MSTP(44).EQ.7) VINT(112)=
1170      &    2D0*XWC*SH*(SH-SQMZ)/((SH-SQMZ)**2+HZ**2)
1171           IF(MSTP(44).EQ.5.OR.MSTP(44).EQ.7) VINT(113)=
1172      &    2D0*XWC*SH*(SH-SQMZP)/((SH-SQMZP)**2+HZP**2)
1173           IF(MSTP(44).EQ.2.OR.MSTP(44).EQ.4.OR.MSTP(44).EQ.6.OR.
1174      &    MSTP(44).EQ.7) VINT(114)=XWC**2*SH**2/((SH-SQMZ)**2+HZ**2)
1175           IF(MSTP(44).EQ.6.OR.MSTP(44).EQ.7) VINT(115)=
1176      &    2D0*XWC**2*SH**2*((SH-SQMZ)*(SH-SQMZP)+HZ*HZP)/
1177      &    (((SH-SQMZ)**2+HZ**2)*((SH-SQMZP)**2+HZP**2))
1178           IF(MSTP(44).EQ.3.OR.MSTP(44).EQ.5.OR.MSTP(44).EQ.6.OR.
1179      &    MSTP(44).EQ.7) VINT(116)=XWC**2*SH**2/((SH-SQMZP)**2+HZP**2)
1180         ENDIF
1181         DO 290 I=1,MDCY(KC,3)
1182           IDC=I+MDCY(KC,2)-1
1183           IF(MDME(IDC,1).LT.0) GOTO 290
1184           RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
1185           RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
1186           IF(SQRT(RM1)+SQRT(RM2).GT.1D0.OR.MDME(IDC,1).LT.0) GOTO 290
1187           WID2=1D0
1188           IF(I.LE.16) THEN
1189             IF(I.LE.8) THEN
1190 C...Z'0 -> q + qbar
1191               EF=KCHG(I,1)/3D0
1192               AF=SIGN(1D0,EF+0.1D0)
1193               VF=AF-4D0*EF*XWV
1194               IF(I.LE.2) THEN
1195                 VPF=PARU(123-2*MOD(I,2))
1196                 APF=PARU(124-2*MOD(I,2))
1197               ELSEIF(I.LE.4) THEN
1198                 VPF=PARJ(182-2*MOD(I,2))
1199                 APF=PARJ(183-2*MOD(I,2))
1200               ELSE
1201                 VPF=PARJ(190-2*MOD(I,2))
1202                 APF=PARJ(191-2*MOD(I,2))
1203               ENDIF
1204               FCOF=3D0*RADC
1205               IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF*
1206      &        PYHFTH(SH,SH*RM1,1D0)
1207               IF(I.EQ.6) WID2=WIDS(6,1)
1208               IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1)
1209             ELSEIF(I.LE.16) THEN
1210 C...Z'0 -> l+ + l-, nu + nubar
1211               EF=KCHG(I+2,1)/3D0
1212               AF=SIGN(1D0,EF+0.1D0)
1213               VF=AF-4D0*EF*XWV
1214               IF(I.LE.10) THEN
1215                 VPF=PARU(127-2*MOD(I,2))
1216                 APF=PARU(128-2*MOD(I,2))
1217               ELSEIF(I.LE.12) THEN
1218                 VPF=PARJ(186-2*MOD(I,2))
1219                 APF=PARJ(187-2*MOD(I,2))
1220               ELSE
1221                 VPF=PARJ(194-2*MOD(I,2))
1222                 APF=PARJ(195-2*MOD(I,2))
1223               ENDIF
1224               FCOF=1D0
1225               IF((I.EQ.15.OR.I.EQ.16)) WID2=WIDS(2+I,1)
1226             ENDIF
1227             BE34=SQRT(MAX(0D0,1D0-4D0*RM1))
1228             IF(ICASE.EQ.1) THEN
1229               WDTPZ=FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))*BE34
1230               WDTP(I)=FAC*FCOF*(VPF**2*(1D0+2D0*RM1)+
1231      &        APF**2*(1D0-4D0*RM1))*BE34
1232             ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN
1233               WDTP(I)=FAC*FCOF*((EI**2*VINT(111)*EF**2+EI*VI*VINT(112)*
1234      &        EF*VF+EI*VPI*VINT(113)*EF*VPF+(VI**2+AI**2)*VINT(114)*
1235      &        VF**2+(VI*VPI+AI*API)*VINT(115)*VF*VPF+(VPI**2+API**2)*
1236      &        VINT(116)*VPF**2)*(1D0+2D0*RM1)+((VI**2+AI**2)*VINT(114)*
1237      &        AF**2+(VI*VPI+AI*API)*VINT(115)*AF*APF+(VPI**2+API**2)*
1238      &        VINT(116)*APF**2)*(1D0-4D0*RM1))*BE34
1239             ELSEIF(MINT(61).EQ.2) THEN
1240               FGGF=FCOF*EF**2*(1D0+2D0*RM1)*BE34
1241               FGZF=FCOF*EF*VF*(1D0+2D0*RM1)*BE34
1242               FGZPF=FCOF*EF*VPF*(1D0+2D0*RM1)*BE34
1243               FZZF=FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))*BE34
1244               FZZPF=FCOF*(VF*VPF*(1D0+2D0*RM1)+AF*APF*(1D0-4D0*RM1))*
1245      &        BE34
1246               FZPZPF=FCOF*(VPF**2*(1D0+2D0*RM1)+APF**2*(1D0-4D0*RM1))*
1247      &        BE34
1248             ENDIF
1249           ELSEIF(I.EQ.17) THEN
1250 C...Z'0 -> W+ + W-
1251             WDTPZP=PARU(129)**2*XW1**2*
1252      &      SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3*
1253      &      (1D0+10D0*RM1+10D0*RM2+RM1**2+RM2**2+10D0*RM1*RM2)
1254             IF(ICASE.EQ.1) THEN
1255               WDTPZ=0D0
1256               WDTP(I)=FAC*WDTPZP
1257             ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN
1258               WDTP(I)=FAC*(VPI**2+API**2)*VINT(116)*WDTPZP
1259             ELSEIF(MINT(61).EQ.2) THEN
1260               FGGF=0D0
1261               FGZF=0D0
1262               FGZPF=0D0
1263               FZZF=0D0
1264               FZZPF=0D0
1265               FZPZPF=WDTPZP
1266             ENDIF
1267             WID2=WIDS(24,1)
1268           ELSEIF(I.EQ.18) THEN
1269 C...Z'0 -> H+ + H-
1270             CZC=2D0*(1D0-2D0*XW)
1271             BE34C=(1D0-4D0*RM1)*SQRT(MAX(0D0,1D0-4D0*RM1))
1272             IF(ICASE.EQ.1) THEN
1273               WDTPZ=0.25D0*PARU(142)**2*CZC**2*BE34C
1274               WDTP(I)=FAC*0.25D0*PARU(143)**2*CZC**2*BE34C
1275             ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN
1276               WDTP(I)=FAC*0.25D0*(EI**2*VINT(111)+PARU(142)*EI*VI*
1277      &        VINT(112)*CZC+PARU(143)*EI*VPI*VINT(113)*CZC+PARU(142)**2*
1278      &        (VI**2+AI**2)*VINT(114)*CZC**2+PARU(142)*PARU(143)*
1279      &        (VI*VPI+AI*API)*VINT(115)*CZC**2+PARU(143)**2*
1280      &        (VPI**2+API**2)*VINT(116)*CZC**2)*BE34C
1281             ELSEIF(MINT(61).EQ.2) THEN
1282               FGGF=0.25D0*BE34C
1283               FGZF=0.25D0*PARU(142)*CZC*BE34C
1284               FGZPF=0.25D0*PARU(143)*CZC*BE34C
1285               FZZF=0.25D0*PARU(142)**2*CZC**2*BE34C
1286               FZZPF=0.25D0*PARU(142)*PARU(143)*CZC**2*BE34C
1287               FZPZPF=0.25D0*PARU(143)**2*CZC**2*BE34C
1288             ENDIF
1289             WID2=WIDS(37,1)
1290           ELSEIF(I.EQ.19) THEN
1291 C...Z'0 -> Z0 + gamma.
1292           ELSEIF(I.EQ.20) THEN
1293 C...Z'0 -> Z0 + h0
1294             FLAM=SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))
1295             WDTPZP=PARU(145)**2*4D0*ABS(1D0-2D0*XW)*
1296      &      (3D0*RM1+0.25D0*FLAM**2)*FLAM
1297             IF(ICASE.EQ.1) THEN
1298               WDTPZ=0D0
1299               WDTP(I)=FAC*WDTPZP
1300             ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN
1301               WDTP(I)=FAC*(VPI**2+API**2)*VINT(116)*WDTPZP
1302             ELSEIF(MINT(61).EQ.2) THEN
1303               FGGF=0D0
1304               FGZF=0D0
1305               FGZPF=0D0
1306               FZZF=0D0
1307               FZZPF=0D0
1308               FZPZPF=WDTPZP
1309             ENDIF
1310             WID2=WIDS(23,2)*WIDS(25,2)
1311           ELSEIF(I.EQ.21.OR.I.EQ.22) THEN
1312 C...Z' -> h0 + A0 or H0 + A0.
1313             BE34C=SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3
1314             IF(I.EQ.21) THEN
1315               CZAH=PARU(186)
1316               CZPAH=PARU(188)
1317             ELSE
1318               CZAH=PARU(187)
1319               CZPAH=PARU(189)
1320             ENDIF
1321             IF(ICASE.EQ.1) THEN
1322               WDTPZ=CZAH**2*BE34C
1323               WDTP(I)=FAC*CZPAH**2*BE34C
1324             ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN
1325               WDTP(I)=FAC*(CZAH**2*(VI**2+AI**2)*VINT(114)+CZAH*CZPAH*
1326      &        (VI*VPI+AI*API)*VINT(115)+CZPAH**2*(VPI**2+API**2)*
1327      &        VINT(116))*BE34C
1328             ELSEIF(MINT(61).EQ.2) THEN
1329               FGGF=0D0
1330               FGZF=0D0
1331               FGZPF=0D0
1332               FZZF=CZAH**2*BE34C
1333               FZZPF=CZAH*CZPAH*BE34C
1334               FZPZPF=CZPAH**2*BE34C
1335             ENDIF
1336             IF(I.EQ.21) WID2=WIDS(25,2)*WIDS(36,2)
1337             IF(I.EQ.22) WID2=WIDS(35,2)*WIDS(36,2)
1338           ENDIF
1339           IF(ICASE.EQ.1) THEN
1340             VINT(117)=VINT(117)+FAC*WDTPZ
1341             WDTP(I)=FUDGE*WDTP(I)
1342             WDTP(0)=WDTP(0)+WDTP(I)
1343           ENDIF
1344           IF(MDME(IDC,1).GT.0) THEN
1345             IF((ICASE.EQ.1.AND.MINT(61).NE.1).OR.
1346      &      (ICASE.EQ.2.AND.MINT(61).EQ.1)) THEN
1347               WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
1348               WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+
1349      &        WDTE(I,MDME(IDC,1))
1350               WDTE(I,0)=WDTE(I,MDME(IDC,1))
1351               WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
1352             ENDIF
1353             IF(MINT(61).EQ.2.AND.ICASE.EQ.2) THEN
1354               IF(MSTP(44).EQ.1.OR.MSTP(44).EQ.4.OR.MSTP(44).EQ.5.OR.
1355      &        MSTP(44).EQ.7) VINT(111)=VINT(111)+FGGF*WID2
1356               IF(MSTP(44).EQ.4.OR.MSTP(44).EQ.7) VINT(112)=VINT(112)+
1357      &        FGZF*WID2
1358               IF(MSTP(44).EQ.5.OR.MSTP(44).EQ.7) VINT(113)=VINT(113)+
1359      &        FGZPF*WID2
1360               IF(MSTP(44).EQ.2.OR.MSTP(44).EQ.4.OR.MSTP(44).EQ.6.OR.
1361      &        MSTP(44).EQ.7) VINT(114)=VINT(114)+FZZF*WID2
1362               IF(MSTP(44).EQ.6.OR.MSTP(44).EQ.7) VINT(115)=VINT(115)+
1363      &        FZZPF*WID2
1364               IF(MSTP(44).EQ.3.OR.MSTP(44).EQ.5.OR.MSTP(44).EQ.6.OR.
1365      &        MSTP(44).EQ.7) VINT(116)=VINT(116)+FZPZPF*WID2
1366             ENDIF
1367           ENDIF
1368   290   CONTINUE
1369         IF(MINT(61).GE.1) ICASE=3-ICASE
1370         IF(ICASE.EQ.2) GOTO 280
1371
1372       ELSEIF(KFLA.EQ.34) THEN
1373 C...W'+/-:
1374         FAC=(AEM/(24D0*XW))*SHR
1375         DO 300 I=1,MDCY(KC,3)
1376           IDC=I+MDCY(KC,2)-1
1377           IF(MDME(IDC,1).LT.0) GOTO 300
1378           RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
1379           RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
1380           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 300
1381           WID2=1D0
1382           IF(I.LE.20) THEN
1383             IF(I.LE.16) THEN
1384 C...W'+/- -> q + qbar'
1385               FCOF=3D0*RADC*(PARU(131)**2+PARU(132)**2)*
1386      &        VCKM((I-1)/4+1,MOD(I-1,4)+1)
1387               IF(KFLR.GT.0) THEN
1388                 IF(MOD(I,4).EQ.3) WID2=WIDS(6,2)
1389                 IF(MOD(I,4).EQ.0) WID2=WIDS(8,2)
1390                 IF(I.GE.13) WID2=WID2*WIDS(7,3)
1391               ELSE
1392                 IF(MOD(I,4).EQ.3) WID2=WIDS(6,3)
1393                 IF(MOD(I,4).EQ.0) WID2=WIDS(8,3)
1394                 IF(I.GE.13) WID2=WID2*WIDS(7,2)
1395               ENDIF
1396             ELSEIF(I.LE.20) THEN
1397 C...W'+/- -> l+/- + nu
1398               FCOF=PARU(133)**2+PARU(134)**2
1399               IF(KFLR.GT.0) THEN
1400                 IF(I.EQ.20) WID2=WIDS(17,3)*WIDS(18,2)
1401               ELSE
1402                 IF(I.EQ.20) WID2=WIDS(17,2)*WIDS(18,3)
1403               ENDIF
1404             ENDIF
1405             WDTP(I)=FAC*FCOF*0.5D0*(2D0-RM1-RM2-(RM1-RM2)**2)*
1406      &      SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))
1407           ELSEIF(I.EQ.21) THEN
1408 C...W'+/- -> W+/- + Z0
1409             WDTP(I)=FAC*PARU(135)**2*0.5D0*XW1*(RM1/RM2)*
1410      &      SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3*
1411      &      (1D0+10D0*RM1+10D0*RM2+RM1**2+RM2**2+10D0*RM1*RM2)
1412             IF(KFLR.GT.0) WID2=WIDS(24,2)*WIDS(23,2)
1413             IF(KFLR.LT.0) WID2=WIDS(24,3)*WIDS(23,2)
1414           ELSEIF(I.EQ.23) THEN
1415 C...W'+/- -> W+/- + h0
1416             FLAM=SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))
1417             WDTP(I)=FAC*PARU(146)**2*2D0*(3D0*RM1+0.25D0*FLAM**2)*FLAM
1418             IF(KFLR.GT.0) WID2=WIDS(24,2)*WIDS(25,2)
1419             IF(KFLR.LT.0) WID2=WIDS(24,3)*WIDS(25,2)
1420           ENDIF
1421           WDTP(I)=FUDGE*WDTP(I)
1422           WDTP(0)=WDTP(0)+WDTP(I)
1423           IF(MDME(IDC,1).GT.0) THEN
1424             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
1425             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
1426             WDTE(I,0)=WDTE(I,MDME(IDC,1))
1427             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
1428           ENDIF
1429   300   CONTINUE
1430
1431       ELSEIF(KFLA.EQ.37) THEN
1432 C...H+/-:
1433 C        IF(MSTP(49).EQ.0) THEN
1434         SHFS=SH
1435 C        ELSE
1436 C          SHFS=PMAS(37,1)**2
1437 C        ENDIF
1438         FAC=(AEM/(8D0*XW))*(SHFS/PMAS(24,1)**2)*SHR
1439         DO 310 I=1,MDCY(KC,3)
1440           IDC=I+MDCY(KC,2)-1
1441           IF(MDME(IDC,1).LT.0) GOTO 310
1442           KFC1=PYCOMP(KFDP(IDC,1))
1443           KFC2=PYCOMP(KFDP(IDC,2))
1444           RM1=PMAS(KFC1,1)**2/SH
1445           RM2=PMAS(KFC2,1)**2/SH
1446           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 310
1447           WID2=1D0
1448           IF(I.LE.4) THEN
1449 C...H+/- -> q + qbar'
1450             RM1R=PYMRUN(KFDP(IDC,1),SH)**2/SH
1451             RM2R=PYMRUN(KFDP(IDC,2),SH)**2/SH
1452             WDTP(I)=FAC*3D0*RADC*MAX(0D0,(RM1R*PARU(141)**2+
1453      &      RM2R/PARU(141)**2)*(1D0-RM1R-RM2R)-4D0*RM1R*RM2R)*
1454      &      SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))*(SH/SHFS)
1455             IF(KFLR.GT.0) THEN
1456               IF(I.EQ.3) WID2=WIDS(6,2)
1457               IF(I.EQ.4) WID2=WIDS(7,3)*WIDS(8,2)
1458             ELSE
1459               IF(I.EQ.3) WID2=WIDS(6,3)
1460               IF(I.EQ.4) WID2=WIDS(7,2)*WIDS(8,3)
1461             ENDIF
1462           ELSEIF(I.LE.8) THEN
1463 C...H+/- -> l+/- + nu
1464             WDTP(I)=FAC*((RM1*PARU(141)**2+RM2/PARU(141)**2)*
1465      &      (1D0-RM1-RM2)-4D0*RM1*RM2)*SQRT(MAX(0D0,
1466      &      (1D0-RM1-RM2)**2-4D0*RM1*RM2))*(SH/SHFS)
1467             IF(KFLR.GT.0) THEN
1468               IF(I.EQ.8) WID2=WIDS(17,3)*WIDS(18,2)
1469             ELSE
1470               IF(I.EQ.8) WID2=WIDS(17,2)*WIDS(18,3)
1471             ENDIF
1472           ELSEIF(I.EQ.9) THEN
1473 C...H+/- -> W+/- + h0.
1474             WDTP(I)=FAC*PARU(195)**2*0.5D0*SQRT(MAX(0D0,
1475      &      (1D0-RM1-RM2)**2-4D0*RM1*RM2))**3
1476             IF(KFLR.GT.0) WID2=WIDS(24,2)*WIDS(25,2)
1477             IF(KFLR.LT.0) WID2=WIDS(24,3)*WIDS(25,2)
1478
1479 CMRENNA++
1480           ELSE
1481 C...Add in SUSY decays (two-body) by rescaling by phase space factor.
1482             RM10=RM1*SH/PMR**2
1483             RM20=RM2*SH/PMR**2
1484             WFAC0=1D0+RM10**2+RM20**2-2D0*(RM10+RM20+RM10*RM20)
1485             WFAC=1D0+RM1**2+RM2**2-2D0*(RM1+RM2+RM1*RM2)
1486             IF(WFAC.LE.0D0 .OR. WFAC0.LE.0D0) THEN
1487               WFAC=0D0
1488             ELSE
1489               WFAC=WFAC/WFAC0
1490             ENDIF
1491             WDTP(I)=PMAS(KC,2)*BRAT(IDC)*(SHR/PMR)*SQRT(WFAC)
1492 CMRENNA--
1493             KSGN1=2
1494             IF(KFLS*KFDP(IDC,1).LT.0.AND.KCHG(KFC1,3).EQ.1) KSGN1=3
1495             KSGN2=2
1496             IF(KFLS*KFDP(IDC,2).LT.0.AND.KCHG(KFC2,3).EQ.1) KSGN2=3
1497             WID2=WIDS(KFC1,KSGN1)*WIDS(KFC2,KSGN2)
1498           ENDIF
1499           WDTP(I)=FUDGE*WDTP(I)
1500           WDTP(0)=WDTP(0)+WDTP(I)
1501           IF(MDME(IDC,1).GT.0) THEN
1502             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
1503             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
1504             WDTE(I,0)=WDTE(I,MDME(IDC,1))
1505             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
1506           ENDIF
1507   310   CONTINUE
1508
1509       ELSEIF(KFLA.EQ.41) THEN
1510 C...R:
1511         FAC=(AEM/(12D0*XW))*SHR
1512         DO 320 I=1,MDCY(KC,3)
1513           IDC=I+MDCY(KC,2)-1
1514           IF(MDME(IDC,1).LT.0) GOTO 320
1515           RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
1516           RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
1517           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 320
1518           WID2=1D0
1519           IF(I.LE.6) THEN
1520 C...R -> q + qbar'
1521             FCOF=3D0*RADC
1522           ELSEIF(I.LE.9) THEN
1523 C...R -> l+ + l'-
1524             FCOF=1D0
1525           ENDIF
1526           WDTP(I)=FAC*FCOF*(2D0-RM1-RM2-(RM1-RM2)**2)*
1527      &    SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))
1528           IF(KFLR.GT.0) THEN
1529             IF(I.EQ.4) WID2=WIDS(6,3)
1530             IF(I.EQ.5) WID2=WIDS(7,3)
1531             IF(I.EQ.6) WID2=WIDS(6,2)*WIDS(8,3)
1532             IF(I.EQ.9) WID2=WIDS(17,3)
1533           ELSE
1534             IF(I.EQ.4) WID2=WIDS(6,2)
1535             IF(I.EQ.5) WID2=WIDS(7,2)
1536             IF(I.EQ.6) WID2=WIDS(6,3)*WIDS(8,2)
1537             IF(I.EQ.9) WID2=WIDS(17,2)
1538           ENDIF
1539           WDTP(I)=FUDGE*WDTP(I)
1540           WDTP(0)=WDTP(0)+WDTP(I)
1541           IF(MDME(IDC,1).GT.0) THEN
1542             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
1543             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
1544             WDTE(I,0)=WDTE(I,MDME(IDC,1))
1545             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
1546           ENDIF
1547   320   CONTINUE
1548
1549       ELSEIF(KFLA.EQ.42) THEN
1550 C...LQ (leptoquark).
1551         FAC=(AEM/4D0)*PARU(151)*SHR
1552         DO 330 I=1,MDCY(KC,3)
1553           IDC=I+MDCY(KC,2)-1
1554           IF(MDME(IDC,1).LT.0) GOTO 330
1555           RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
1556           RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
1557           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 330
1558           WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3
1559           WID2=1D0
1560           ILQQ=KFDP(IDC,1)*ISIGN(1,KFLR)
1561           IF(ILQQ.GE.6) WID2=WIDS(ILQQ,2)
1562           IF(ILQQ.LE.-6) WID2=WIDS(-ILQQ,3)
1563           ILQL=KFDP(IDC,2)*ISIGN(1,KFLR)
1564           IF(ILQL.GE.17) WID2=WID2*WIDS(ILQL,2)
1565           IF(ILQL.LE.-17) WID2=WID2*WIDS(-ILQL,3)
1566           WDTP(I)=FUDGE*WDTP(I)
1567           WDTP(0)=WDTP(0)+WDTP(I)
1568           IF(MDME(IDC,1).GT.0) THEN
1569             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
1570             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
1571             WDTE(I,0)=WDTE(I,MDME(IDC,1))
1572             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
1573           ENDIF
1574   330   CONTINUE
1575
1576       ELSEIF(KFLA.EQ.KTECHN+111.OR.KFLA.EQ.KTECHN+221) THEN
1577 C...Techni-pi0 and techni-pi0':
1578         FAC=(1D0/(32D0*PARU(1)*RTCM(1)**2))*SHR
1579         DO 340 I=1,MDCY(KC,3)
1580           IDC=I+MDCY(KC,2)-1
1581           IF(MDME(IDC,1).LT.0) GOTO 340
1582           PM1=PMAS(PYCOMP(KFDP(IDC,1)),1)
1583           PM2=PMAS(PYCOMP(KFDP(IDC,2)),1)
1584           RM1=PM1**2/SH
1585           RM2=PM2**2/SH
1586           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 340
1587           WID2=1D0
1588 C...pi_tc -> g + g
1589           IF(I.EQ.8) THEN
1590             FACP=(AS/(4D0*PARU(1))*ITCM(1)/RTCM(1))**2
1591      &      /(8D0*PARU(1))*SH*SHR
1592             IF(KFLA.EQ.KTECHN+111) THEN
1593               FACP=FACP*RTCM(9)
1594             ELSE
1595               FACP=FACP*RTCM(10)
1596             ENDIF
1597             WDTP(I)=FACP
1598           ELSE
1599 C...pi_tc -> f + fbar.
1600             FCOF=1D0
1601             IKA=IABS(KFDP(IDC,1))
1602             IF(IKA.LT.10) FCOF=3D0*RADC
1603             HM1=PM1
1604             HM2=PM2
1605             IF(IKA.GE.4.AND.IKA.LE.6) THEN
1606                FCOF=FCOF*RTCM(1+IKA)**2
1607                HM1=PYMRUN(KFDP(IDC,1),SH)
1608                HM2=PYMRUN(KFDP(IDC,2),SH)
1609             ELSEIF(IKA.EQ.15) THEN
1610                FCOF=FCOF*RTCM(8)**2
1611             ENDIF
1612             WDTP(I)=FAC*FCOF*(HM1+HM2)**2*
1613      &      SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))
1614           ENDIF
1615           WDTP(I)=FUDGE*WDTP(I)
1616           WDTP(0)=WDTP(0)+WDTP(I)
1617           IF(MDME(IDC,1).GT.0) THEN
1618             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
1619             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
1620             WDTE(I,0)=WDTE(I,MDME(IDC,1))
1621             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
1622           ENDIF
1623   340   CONTINUE
1624
1625       ELSEIF(KFLA.EQ.KTECHN+211) THEN
1626 C...pi+_tc
1627         FAC=(1D0/(32D0*PARU(1)*RTCM(1)**2))*SHR
1628         DO 350 I=1,MDCY(KC,3)
1629           IDC=I+MDCY(KC,2)-1
1630           IF(MDME(IDC,1).LT.0) GOTO 350
1631           PM1=PMAS(PYCOMP(KFDP(IDC,1)),1)
1632           PM2=PMAS(PYCOMP(KFDP(IDC,2)),1)
1633           PM3=0D0
1634           IF(I.EQ.5) PM3=PMAS(PYCOMP(KFDP(IDC,3)),1)
1635           RM1=PM1**2/SH
1636           RM2=PM2**2/SH
1637           RM3=PM3**2/SH
1638           IF(SQRT(RM1)+SQRT(RM2)+SQRT(RM3).GT.1D0) GOTO 350
1639           WID2=1D0
1640 C...pi_tc -> f + f'.
1641           FCOF=1D0
1642           IF(IABS(KFDP(IDC,1)).LT.10) FCOF=3D0*RADC
1643 C...pi_tc+ -> W b b~
1644           IF(I.EQ.5.AND.SHR.LT.PMAS(6,1)+PMAS(5,1)) THEN
1645             FCOF=3D0*RADC
1646             XMT2=PMAS(6,1)**2/SH
1647             FACP=FAC/(4D0*PARU(1))*FCOF*XMT2*RTCM(7)**2
1648             KFC3=PYCOMP(KFDP(IDC,3))
1649             CHECK = SQRT(RM1)+SQRT(RM2)+SQRT(RM3)
1650             CHECK = SQRT(RM1)
1651             T0 = (1D0-CHECK**2)*
1652      &      (XMT2*(6D0*XMT2**2+3D0*XMT2*RM1-4D0*RM1**2)-
1653      &      (5D0*XMT2**2+2D0*XMT2*RM1-8D0*RM1**2))/(4D0*XMT2**2)
1654             T1 = (1D0-XMT2)*(RM1-XMT2)*((XMT2**2+XMT2*RM1+4D0*RM1**2)
1655      &      -3D0*XMT2**2*(XMT2+RM1))/(2D0*XMT2**3)
1656             T3 = RM1**2/XMT2**3*(3D0*XMT2-4D0*RM1+4D0*XMT2*RM1)
1657             WDTP(I)=FACP*(T0 + T1*LOG((XMT2-CHECK**2)/(XMT2-1D0))
1658      &      +T3*LOG(CHECK))
1659             IF(KFLR.GT.0) THEN
1660                WID2=WIDS(24,2)
1661             ELSE
1662                WID2=WIDS(24,3)
1663             ENDIF
1664           ELSE
1665             FCOF=1D0
1666             IKA=IABS(KFDP(IDC,1))
1667             IF(IKA.LT.10) FCOF=3D0*RADC
1668             HM1=PM1
1669             HM2=PM2
1670             IF(I.GE.1.AND.I.LE.5) THEN
1671               IF(I.LE.2) THEN
1672                 FCOF=FCOF*RTCM(5)**2
1673               ELSEIF(I.LE.4) THEN
1674                 FCOF=FCOF*RTCM(6)**2
1675               ELSEIF(I.EQ.5) THEN
1676                 FCOF=FCOF*RTCM(7)**2
1677               ENDIF
1678               HM1=PYMRUN(KFDP(IDC,1),SH)
1679               HM2=PYMRUN(KFDP(IDC,2),SH)
1680             ELSEIF(I.EQ.8) THEN
1681               FCOF=FCOF*RTCM(8)**2
1682             ENDIF
1683             WDTP(I)=FAC*FCOF*(HM1+HM2)**2*
1684      &      SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))
1685           ENDIF
1686           WDTP(I)=FUDGE*WDTP(I)
1687           WDTP(0)=WDTP(0)+WDTP(I)
1688           IF(MDME(IDC,1).GT.0) THEN
1689             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
1690             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
1691             WDTE(I,0)=WDTE(I,MDME(IDC,1))
1692             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
1693           ENDIF
1694   350     CONTINUE
1695
1696       ELSEIF(KFLA.EQ.KTECHN+331) THEN
1697 C...Techni-eta.
1698         FAC=(SH/PARP(46)**2)*SHR
1699         DO 360 I=1,MDCY(KC,3)
1700           IDC=I+MDCY(KC,2)-1
1701           IF(MDME(IDC,1).LT.0) GOTO 360
1702           RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
1703           RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
1704           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 360
1705           WID2=1D0
1706           IF(I.LE.2) THEN
1707             WDTP(I)=FAC*RM1*SQRT(MAX(0D0,1D0-4D0*RM1))/(4D0*PARU(1))
1708             IF(I.EQ.2) WID2=WIDS(6,1)
1709           ELSE
1710             WDTP(I)=FAC*5D0*AS**2/(96D0*PARU(1)**3)
1711           ENDIF
1712           WDTP(I)=FUDGE*WDTP(I)
1713           WDTP(0)=WDTP(0)+WDTP(I)
1714           IF(MDME(IDC,1).GT.0) THEN
1715             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
1716             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
1717             WDTE(I,0)=WDTE(I,MDME(IDC,1))
1718             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
1719           ENDIF
1720   360   CONTINUE
1721
1722       ELSEIF(KFLA.EQ.KTECHN+113) THEN
1723 C...Techni-rho0:
1724         ALPRHT=2.91D0*(3D0/ITCM(1))
1725         FAC=(ALPRHT/12D0)*SHR
1726         FACF=(1D0/6D0)*(AEM**2/ALPRHT)*SHR
1727         SQMZ=PMAS(23,1)**2
1728         SQMW=PMAS(24,1)**2
1729         SHP=SH
1730         CALL PYWIDX(23,SHP,WDTPP,WDTEP)
1731         GMMZ=SHR*WDTPP(0)
1732         XWRHT=(1D0-2D0*XW)/(4D0*XW*(1D0-XW))
1733         BWZR=XWRHT*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2)
1734         BWZI=XWRHT*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2)
1735         DO 370 I=1,MDCY(KC,3)
1736           IDC=I+MDCY(KC,2)-1
1737           IF(MDME(IDC,1).LT.0) GOTO 370
1738           RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
1739           RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
1740           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 370
1741           WID2=1D0
1742           IF(I.EQ.1) THEN
1743 C...rho_tc0 -> W+ + W-.
1744             WDTP(I)=FAC*RTCM(3)**4*
1745      &      SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3
1746             WID2=WIDS(24,1)
1747           ELSEIF(I.EQ.2) THEN
1748 C...rho_tc0 -> W+ + pi_tc-.
1749             WDTP(I)=FAC*RTCM(3)**2*(1D0-RTCM(3)**2)*
1750      &      SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3+
1751      &      AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))*
1752      &      ((1D0-RM1-RM2)**2-4D0*RM1*RM2 + 6D0*SQMW/SH)*
1753      &      (1D0-RTCM(3)**2)/4D0/XW/24D0/RTCM(13)**2*SHR**3
1754             WID2=WIDS(24,2)*WIDS(PYCOMP(KTECHN+211),3)
1755           ELSEIF(I.EQ.3) THEN
1756 C...rho_tc0 -> pi_tc+ + W-.
1757             WDTP(I)=FAC*RTCM(3)**2*(1D0-RTCM(3)**2)*
1758      &      SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3+
1759      &      AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))*
1760      &      ((1D0-RM1-RM2)**2-4D0*RM1*RM2 + 6D0*SQMW/SH)*
1761      &      (1D0-RTCM(3)**2)/4D0/XW/24D0/RTCM(13)**2*SHR**3
1762             WID2=WIDS(PYCOMP(KTECHN+211),2)*WIDS(24,3)
1763           ELSEIF(I.EQ.4) THEN
1764 C...rho_tc0 -> pi_tc+ + pi_tc-.
1765             WDTP(I)=FAC*(1D0-RTCM(3)**2)**2*
1766      &      SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3
1767             WID2=WIDS(PYCOMP(KTECHN+211),1)
1768           ELSEIF(I.EQ.5) THEN
1769 C...rho_tc0 -> gamma + pi_tc0
1770             WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3*
1771      &      (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(3)**2)/24D0/RTCM(12)**2*
1772      &      SHR**3
1773             WID2=WIDS(PYCOMP(KTECHN+111),2)
1774           ELSEIF(I.EQ.6) THEN
1775 C...rho_tc0 -> gamma + pi_tc0'
1776             WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3*
1777      &      (1D0-RTCM(4)**2)/24D0/RTCM(12)**2*SHR**3
1778             WID2=WIDS(PYCOMP(KTECHN+221),2)
1779           ELSEIF(I.EQ.7) THEN
1780 C...rho_tc0 -> Z0 + pi_tc0
1781             WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3*
1782      &      (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(3)**2)/24D0/RTCM(12)**2*
1783      &      XW/XW1*SHR**3
1784             WID2=WIDS(23,2)*WIDS(PYCOMP(KTECHN+111),2)
1785           ELSEIF(I.EQ.8) THEN
1786 C...rho_tc0 -> Z0 + pi_tc0'
1787             WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3*
1788      &      (1D0-RTCM(4)**2)/24D0/RTCM(12)**2*(1D0-2D0*XW)**2/4D0/
1789      &      XW/XW1*SHR**3
1790             WID2=WIDS(23,2)*WIDS(PYCOMP(KTECHN+221),2)
1791           ELSE
1792 C...rho_tc0 -> f + fbar.
1793             WID2=1D0
1794             IF(I.LE.16) THEN
1795               IA=I-8
1796               FCOF=3D0*RADC
1797               IF(IA.GE.6.AND.IA.LE.8) WID2=WIDS(IA,1)
1798             ELSE
1799               IA=I-6
1800               FCOF=1D0
1801               IF(IA.GE.17) WID2=WIDS(IA,1)
1802             ENDIF
1803             EI=KCHG(IA,1)/3D0
1804             AI=SIGN(1D0,EI+0.1D0)
1805             VI=AI-4D0*EI*XWV
1806             VALI=0.5D0*(VI+AI)
1807             VARI=0.5D0*(VI-AI)
1808             WDTP(I)=FACF*FCOF*SQRT(MAX(0D0,1D0-4D0*RM1))*((1D0-RM1)*
1809      &      ((EI+VALI*BWZR)**2+(VALI*BWZI)**2+
1810      &      (EI+VARI*BWZR)**2+(VARI*BWZI)**2)+6D0*RM1*(
1811      &      (EI+VALI*BWZR)*(EI+VARI*BWZR)+VALI*VARI*BWZI**2))
1812           ENDIF
1813           WDTP(I)=FUDGE*WDTP(I)
1814           WDTP(0)=WDTP(0)+WDTP(I)
1815           IF(MDME(IDC,1).GT.0) THEN
1816             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
1817             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
1818             WDTE(I,0)=WDTE(I,MDME(IDC,1))
1819             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
1820           ENDIF
1821   370   CONTINUE
1822
1823       ELSEIF(KFLA.EQ.KTECHN+213) THEN
1824 C...Techni-rho+/-:
1825         ALPRHT=2.91D0*(3D0/ITCM(1))
1826         FAC=(ALPRHT/12D0)*SHR
1827         SQMZ=PMAS(23,1)**2
1828         SQMW=PMAS(24,1)**2
1829         SHP=SH
1830         CALL PYWIDX(24,SHP,WDTPP,WDTEP)
1831         GMMW=SHR*WDTPP(0)
1832         FACF=(1D0/12D0)*(AEM**2/ALPRHT)*SHR*
1833      &  (0.125D0/XW**2)*SH**2/((SH-SQMW)**2+GMMW**2)
1834         DO 380 I=1,MDCY(KC,3)
1835           IDC=I+MDCY(KC,2)-1
1836           IF(MDME(IDC,1).LT.0) GOTO 380
1837           RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
1838           RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
1839           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 380
1840           WID2=1D0
1841           IF(I.EQ.1) THEN
1842 C...rho_tc+ -> W+ + Z0.
1843             WDTP(I)=FAC*RTCM(3)**4*
1844      &      SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3
1845             IF(KFLR.GT.0) THEN
1846               WID2=WIDS(24,2)*WIDS(23,2)
1847             ELSE
1848               WID2=WIDS(24,3)*WIDS(23,2)
1849             ENDIF
1850           ELSEIF(I.EQ.2) THEN
1851 C...rho_tc+ -> W+ + pi_tc0.
1852             WDTP(I)=FAC*RTCM(3)**2*(1D0-RTCM(3)**2)*
1853      &      SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3+
1854      &      AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))*
1855      &      ((1D0-RM1-RM2)**2-4D0*RM1*RM2 + 6D0*SQMW/SH)*
1856      &      (1D0-RTCM(3)**2)/4D0/XW/24D0/RTCM(13)**2*SHR**3
1857             IF(KFLR.GT.0) THEN
1858               WID2=WIDS(24,2)*WIDS(PYCOMP(KTECHN+111),2)
1859             ELSE
1860               WID2=WIDS(24,3)*WIDS(PYCOMP(KTECHN+111),2)
1861             ENDIF
1862           ELSEIF(I.EQ.3) THEN
1863 C...rho_tc+ -> pi_tc+ + Z0.
1864             WDTP(I)=FAC*RTCM(3)**2*(1D0-RTCM(3)**2)*
1865      &      SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3+
1866      &      AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))*
1867      &      ((1D0-RM1-RM2)**2-4D0*RM1*RM2 + 6D0*SQMZ/SH)*
1868      &      (1D0-RTCM(3)**2)/4D0/XW/XW1/24D0/RTCM(13)**2*SHR**3+
1869      &      AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3*
1870      &      (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(3)**2)/24D0/RTCM(12)**2*
1871      &      SHR**3*XW/XW1
1872             IF(KFLR.GT.0) THEN
1873               WID2=WIDS(PYCOMP(KTECHN+211),2)*WIDS(23,2)
1874             ELSE
1875               WID2=WIDS(PYCOMP(KTECHN+211),3)*WIDS(23,2)
1876             ENDIF
1877           ELSEIF(I.EQ.4) THEN
1878 C...rho_tc+ -> pi_tc+ + pi_tc0.
1879             WDTP(I)=FAC*(1D0-RTCM(3)**2)**2*
1880      &      SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3
1881             IF(KFLR.GT.0) THEN
1882               WID2=WIDS(PYCOMP(KTECHN+211),2)*WIDS(PYCOMP(KTECHN+111),2)
1883             ELSE
1884               WID2=WIDS(PYCOMP(KTECHN+211),3)*WIDS(PYCOMP(KTECHN+111),2)
1885             ENDIF
1886           ELSEIF(I.EQ.5) THEN
1887 C...rho_tc+ -> pi_tc+ + gamma
1888             WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3*
1889      &      (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(3)**2)/24D0/RTCM(12)**2*
1890      &      SHR**3
1891             IF(KFLR.GT.0) THEN
1892               WID2=WIDS(PYCOMP(KTECHN+211),2)
1893             ELSE
1894               WID2=WIDS(PYCOMP(KTECHN+211),3)
1895             ENDIF
1896           ELSEIF(I.EQ.6) THEN
1897 C...rho_tc+ -> W+ + pi_tc0'
1898             WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3*
1899      &      (1D0-RTCM(4)**2)/4D0/XW/24D0/RTCM(12)**2*SHR**3
1900             IF(KFLR.GT.0) THEN
1901               WID2=WIDS(24,2)*WIDS(PYCOMP(KTECHN+221),2)
1902             ELSE
1903               WID2=WIDS(24,3)*WIDS(PYCOMP(KTECHN+221),2)
1904             ENDIF
1905           ELSE
1906 C...rho_tc+ -> f + fbar'.
1907             IA=I-6
1908             WID2=1D0
1909             IF(IA.LE.16) THEN
1910               FCOF=3D0*RADC*VCKM((IA-1)/4+1,MOD(IA-1,4)+1)
1911               IF(KFLR.GT.0) THEN
1912                 IF(MOD(IA,4).EQ.3) WID2=WIDS(6,2)
1913                 IF(MOD(IA,4).EQ.0) WID2=WIDS(8,2)
1914                 IF(IA.GE.13) WID2=WID2*WIDS(7,3)
1915               ELSE
1916                 IF(MOD(IA,4).EQ.3) WID2=WIDS(6,3)
1917                 IF(MOD(IA,4).EQ.0) WID2=WIDS(8,3)
1918                 IF(IA.GE.13) WID2=WID2*WIDS(7,2)
1919               ENDIF
1920             ELSE
1921               FCOF=1D0
1922               IF(KFLR.GT.0) THEN
1923                 IF(IA.EQ.20) WID2=WIDS(17,3)*WIDS(18,2)
1924               ELSE
1925                 IF(IA.EQ.20) WID2=WIDS(17,2)*WIDS(18,3)
1926               ENDIF
1927             ENDIF
1928             WDTP(I)=FACF*FCOF*(2D0-RM1-RM2-(RM1-RM2)**2)*
1929      &      SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))
1930           ENDIF
1931           WDTP(I)=FUDGE*WDTP(I)
1932           WDTP(0)=WDTP(0)+WDTP(I)
1933           IF(MDME(IDC,1).GT.0) THEN
1934             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
1935             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
1936             WDTE(I,0)=WDTE(I,MDME(IDC,1))
1937             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
1938           ENDIF
1939   380   CONTINUE
1940
1941       ELSEIF(KFLA.EQ.KTECHN+223) THEN
1942 C...Techni-omega:
1943         ALPRHT=2.91D0*(3D0/ITCM(1))
1944         FAC=(ALPRHT/12D0)*SHR
1945         FACF=(1D0/6D0)*(AEM**2/ALPRHT)*SHR*(2D0*RTCM(2)-1D0)**2
1946         SQMZ=PMAS(23,1)**2
1947         SHP=SH
1948         CALL PYWIDX(23,SHP,WDTPP,WDTEP)
1949         GMMZ=SHR*WDTPP(0)
1950         BWZR=(0.5D0/(1D0-XW))*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2)
1951         BWZI=-(0.5D0/(1D0-XW))*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2)
1952         DO 390 I=1,MDCY(KC,3)
1953           IDC=I+MDCY(KC,2)-1
1954           IF(MDME(IDC,1).LT.0) GOTO 390
1955           RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
1956           RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
1957           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 390
1958           WID2=1D0
1959           IF(I.EQ.1) THEN
1960 C...omega_tc0 -> gamma + pi_tc0.
1961             WDTP(I)=AEM/24D0/RTCM(12)**2*(1D0-RTCM(3)**2)*
1962      &      SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3*SHR**3
1963             WID2=WIDS(PYCOMP(KTECHN+111),2)
1964           ELSEIF(I.EQ.2) THEN
1965 C...omega_tc0 -> Z0 + pi_tc0
1966             WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3*
1967      &      (1D0-RTCM(3)**2)/24D0/RTCM(12)**2*(1D0-2D0*XW)**2/4D0/
1968      &      XW/XW1*SHR**3
1969             WID2=WIDS(23,2)*WIDS(PYCOMP(KTECHN+111),2)
1970           ELSEIF(I.EQ.3) THEN
1971 C...omega_tc0 -> gamma + pi_tc0'
1972             WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3*
1973      &      (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(4)**2)/24D0/RTCM(12)**2*
1974      &      SHR**3
1975             WID2=WIDS(PYCOMP(KTECHN+221),2)
1976           ELSEIF(I.EQ.4) THEN
1977 C...omega_tc0 -> Z0 + pi_tc0'
1978             WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3*
1979      &      (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(4)**2)/24D0/RTCM(12)**2*
1980      &      XW/XW1*SHR**3
1981             WID2=WIDS(23,2)*WIDS(PYCOMP(KTECHN+221),2)
1982           ELSEIF(I.EQ.5) THEN
1983 C...omega_tc0 -> W+ + pi_tc-
1984             WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3*
1985      &      (1D0-RTCM(3)**2)/4D0/XW/24D0/RTCM(12)**2*SHR**3+
1986      &      FAC*RTCM(3)**2*(1D0-RTCM(3)**2)*RTCM(11)**2*
1987      &      SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3
1988             WID2=WIDS(24,2)*WIDS(PYCOMP(KTECHN+211),3)
1989           ELSEIF(I.EQ.6) THEN
1990 C...omega_tc0 -> pi_tc+ + W-
1991             WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3*
1992      &      (1D0-RTCM(3)**2)/4D0/XW/24D0/RTCM(12)**2*SHR**3+
1993      &      FAC*RTCM(3)**2*(1D0-RTCM(3)**2)*RTCM(11)**2*
1994      &      SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3
1995             WID2=WIDS(24,3)*WIDS(PYCOMP(KTECHN+211),2)
1996           ELSEIF(I.EQ.7) THEN
1997 C...omega_tc0 -> W+ + W-.
1998             WDTP(I)=FAC*RTCM(3)**4*RTCM(11)**2*
1999      &      SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3
2000             WID2=WIDS(24,1)
2001           ELSEIF(I.EQ.8) THEN
2002 C...omega_tc0 -> pi_tc+ + pi_tc-.
2003             WDTP(I)=FAC*(1D0-RTCM(3)**2)**2*RTCM(11)**2*
2004      &      SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3
2005             WID2=WIDS(PYCOMP(KTECHN+211),1)
2006           ELSE
2007 C...omega_tc0 -> f + fbar.
2008             WID2=1D0
2009             IF(I.LE.14) THEN
2010               IA=I-8
2011               FCOF=3D0*RADC
2012               IF(IA.GE.6.AND.IA.LE.8) WID2=WIDS(IA,1)
2013             ELSE
2014               IA=I-6
2015               FCOF=1D0
2016               IF(IA.GE.17) WID2=WIDS(IA,1)
2017             ENDIF
2018             EI=KCHG(IA,1)/3D0
2019             AI=SIGN(1D0,EI+0.1D0)
2020             VI=AI-4D0*EI*XWV
2021             VALI=-0.5D0*(VI+AI)
2022             VARI=-0.5D0*(VI-AI)
2023             WDTP(I)=FACF*FCOF*SQRT(MAX(0D0,1D0-4D0*RM1))*((1D0-RM1)*
2024      &      ((EI+VALI*BWZR)**2+(VALI*BWZI)**2+
2025      &      (EI+VARI*BWZR)**2+(VARI*BWZI)**2)+6D0*RM1*(
2026      &      (EI+VALI*BWZR)*(EI+VARI*BWZR)+VALI*VARI*BWZI**2))
2027           ENDIF
2028           WDTP(I)=FUDGE*WDTP(I)
2029           WDTP(0)=WDTP(0)+WDTP(I)
2030           IF(MDME(IDC,1).GT.0) THEN
2031             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
2032             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
2033             WDTE(I,0)=WDTE(I,MDME(IDC,1))
2034             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
2035           ENDIF
2036   390   CONTINUE
2037
2038 C.....V8 -> quark anti-quark
2039       ELSEIF(KFLA.EQ.KTECHN+100021) THEN
2040         FAC=AS/6D0*SHR
2041         TANT3=RTCM(21)
2042         IF(ITCM(2).EQ.0) THEN
2043           IMDL=1
2044         ELSEIF(ITCM(2).EQ.1) THEN
2045           IMDL=2
2046         ENDIF
2047         DO 400 I=1,MDCY(KC,3)
2048           IDC=I+MDCY(KC,2)-1
2049           IF(MDME(IDC,1).LT.0) GOTO 400
2050           PM1=PMAS(PYCOMP(KFDP(IDC,1)),1)
2051           RM1=PM1**2/SH
2052           IF(RM1.GT.0.25D0) GOTO 400
2053           WID2=1D0
2054           IF(I.EQ.5.OR.I.EQ.6.OR.IMDL.EQ.2) THEN
2055             FMIX=1D0/TANT3**2
2056           ELSE
2057             FMIX=TANT3**2
2058           ENDIF
2059           WDTP(I)=FAC*(1D0+2D0*RM1)*SQRT(1D0-4D0*RM1)*FMIX
2060           IF(I.EQ.6) WID2=WIDS(6,1)
2061           WDTP(I)=FUDGE*WDTP(I)
2062           WDTP(0)=WDTP(0)+WDTP(I)
2063           IF(MDME(IDC,1).GT.0) THEN
2064             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
2065             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
2066             WDTE(I,0)=WDTE(I,MDME(IDC,1))
2067             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
2068           ENDIF
2069   400   CONTINUE
2070
2071       ELSEIF(KFLA.EQ.KTECHN+100111.OR.KFLA.EQ.KTECHN+200111) THEN
2072         FAC=(1D0/(4D0*PARU(1)*RTCM(1)**2))*SHR
2073         CLEBF=0D0
2074         DO 410 I=1,MDCY(KC,3)
2075           IDC=I+MDCY(KC,2)-1
2076           IF(MDME(IDC,1).LT.0) GOTO 410
2077           RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
2078           RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
2079           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 410
2080           WID2=1D0
2081 C...pi_tc -> g + g
2082           IF(I.EQ.7) THEN
2083             IF(KFLA.EQ.KTECHN+100111) THEN
2084               CLEBG=4D0/3D0
2085             ELSE
2086               CLEBG=5D0/3D0
2087             ENDIF
2088             FACP=(AS/(8D0*PARU(1))*ITCM(1)/RTCM(1))**2
2089      &      /(2D0*PARU(1))*SH*SHR*CLEBG
2090             WDTP(I)=FACP
2091           ELSE
2092 C...pi_tc -> f + fbar.
2093             IF(I.EQ.6) WID2=WIDS(6,1)
2094             FCOF=1D0
2095             IKA=IABS(KFDP(IDC,1))
2096             IF(IKA.LT.10) FCOF=3D0*RADC
2097             HM1=PYMRUN(KFDP(IDC,1),SH)
2098             WDTP(I)=FAC*FCOF*HM1**2*CLEBF*
2099      &      SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))
2100           ENDIF
2101           WDTP(I)=FUDGE*WDTP(I)
2102           WDTP(0)=WDTP(0)+WDTP(I)
2103           IF(MDME(IDC,1).GT.0) THEN
2104             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
2105             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
2106             WDTE(I,0)=WDTE(I,MDME(IDC,1))
2107             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
2108           ENDIF
2109   410   CONTINUE
2110
2111       ELSEIF(KFLA.GE.KTECHN+100113.AND.KFLA.LE.KTECHN+400113) THEN
2112         FAC=AS/6D0*SHR
2113         ALPRHT=2.91D0*(3D0/ITCM(1))
2114         TANT3=RTCM(21)
2115         SIN2T=2D0*TANT3/(TANT3**2+1D0)
2116         SINT3=TANT3/SQRT(TANT3**2+1D0)
2117         CSXPP=RTCM(22)
2118         RM82=RTCM(27)**2
2119         X12=(RTCM(29)*SQRT(1D0-RTCM(29)**2)*COS(RTCM(30))+
2120      &  RTCM(31)*SQRT(1D0-RTCM(31)**2)*COS(RTCM(32)))/SQRT(2D0)
2121         X21=(RTCM(29)*SQRT(1D0-RTCM(29)**2)*SIN(RTCM(30))+
2122      &  RTCM(31)*SQRT(1D0-RTCM(31)**2)*SIN(RTCM(32)))/SQRT(2D0)
2123         X11=(.25D0*(RTCM(29)**2+RTCM(31)**2+2D0)-
2124      &  SINT3**2)*2D0
2125         X22=(.25D0*(2D0-RTCM(29)**2-RTCM(31)**2)-
2126      &  SINT3**2)*2D0
2127         CALL PYWIDX(KTECHN+100021,SH,WDTPP,WDTEP)
2128
2129         IF(WDTPP(0).GT.RTCM(33)*SHR) WDTPP(0)=RTCM(33)*SHR
2130         GMV8=SHR*WDTPP(0)
2131         RMV8=PMAS(PYCOMP(KTECHN+100021),1)
2132         FV8RE=SH*(SH-RMV8**2)/((SH-RMV8**2)**2+GMV8**2)
2133         FV8IM=SH*GMV8/((SH-RMV8**2)**2+GMV8**2)
2134         IF(ITCM(2).EQ.0) THEN
2135           IMDL=1
2136         ELSE
2137           IMDL=2
2138         ENDIF
2139         DO 420 I=1,MDCY(KC,3)
2140           IF(I.EQ.7.AND.(KFLA.EQ.KTECHN+200113.OR.
2141      &    KFLA.EQ.KTECHN+300113)) GOTO 420
2142           IDC=I+MDCY(KC,2)-1
2143           IF(MDME(IDC,1).LT.0) GOTO 420
2144           RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
2145           RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
2146           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 420
2147           WID2=1D0
2148           IF(I.LE.6) THEN
2149             IF(I.EQ.6) WID2=WIDS(6,1)
2150             XIG=1D0
2151             IF(KFLA.EQ.KTECHN+200113) THEN
2152               XIG=0D0
2153               XIJ=X12
2154             ELSEIF(KFLA.EQ.KTECHN+300113) THEN
2155               XIG=0D0
2156               XIJ=X21
2157             ELSEIF(KFLA.EQ.KTECHN+100113) THEN
2158               XIJ=X11
2159             ELSE
2160               XIJ=X22
2161             ENDIF
2162             IF(I.EQ.5.OR.I.EQ.6.OR.IMDL.EQ.2) THEN
2163               FMIX=1D0/TANT3/SIN2T
2164             ELSE
2165               FMIX=-TANT3/SIN2T
2166             ENDIF
2167             XFAC=(XIG+FMIX*XIJ*FV8RE)**2+(FMIX*XIJ*FV8IM)**2
2168             WDTP(I)=FAC*(1D0+2D0*RM1)*SQRT(1D0-4D0*RM1)*AS/ALPRHT*XFAC
2169           ELSEIF(I.EQ.7) THEN
2170             WDTP(I)=SHR*AS**2/(4D0*ALPRHT)
2171           ELSEIF(KFLA.EQ.KTECHN+400113.AND.I.LE.9) THEN
2172             PSH=SHR*(1D0-RM1)/2D0
2173             WDTP(I)=AS/9D0*PSH**3/RM82
2174             IF(I.EQ.8) THEN
2175               WDTP(I)=2D0*WDTP(I)*CSXPP**2
2176               WID2=WIDS(PYCOMP(KFDP(IDC,1)),2)
2177             ELSE
2178               WDTP(I)=5D0*WDTP(I)
2179               WID2=WIDS(PYCOMP(KFDP(IDC,1)),2)
2180             ENDIF
2181           ENDIF
2182           WDTP(I)=FUDGE*WDTP(I)
2183           WDTP(0)=WDTP(0)+WDTP(I)
2184           IF(MDME(IDC,1).GT.0) THEN
2185             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
2186             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
2187             WDTE(I,0)=WDTE(I,MDME(IDC,1))
2188             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
2189           ENDIF
2190   420   CONTINUE
2191
2192       ELSEIF(KFLA.EQ.KEXCIT+1) THEN
2193 C...d* excited quark.
2194         FAC=(SH/RTCM(41)**2)*SHR
2195         DO 430 I=1,MDCY(KC,3)
2196           IDC=I+MDCY(KC,2)-1
2197           IF(MDME(IDC,1).LT.0) GOTO 430
2198           RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
2199           RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
2200           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 430
2201           WID2=1D0
2202           IF(I.EQ.1) THEN
2203 C...d* -> g + d.
2204             WDTP(I)=FAC*AS*RTCM(45)**2/3D0
2205             WID2=1D0
2206           ELSEIF(I.EQ.2) THEN
2207 C...d* -> gamma + d.
2208             QF=-RTCM(43)/2D0+RTCM(44)/6D0
2209             WDTP(I)=FAC*AEM*QF**2/4D0
2210             WID2=1D0
2211           ELSEIF(I.EQ.3) THEN
2212 C...d* -> Z0 + d.
2213             QF=-RTCM(43)*XW1/2D0-RTCM(44)*XW/6D0
2214             WDTP(I)=FAC*AEM*QF**2/(8D0*XW*XW1)*
2215      &      (1D0-RM1)**2*(2D0+RM1)
2216             WID2=WIDS(23,2)
2217           ELSEIF(I.EQ.4) THEN
2218 C...d* -> W- + u.
2219             WDTP(I)=FAC*AEM*RTCM(43)**2/(16D0*XW)*
2220      &      (1D0-RM1)**2*(2D0+RM1)
2221             IF(KFLR.GT.0) WID2=WIDS(24,3)
2222             IF(KFLR.LT.0) WID2=WIDS(24,2)
2223           ENDIF
2224           WDTP(I)=FUDGE*WDTP(I)
2225           WDTP(0)=WDTP(0)+WDTP(I)
2226           IF(MDME(IDC,1).GT.0) THEN
2227             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
2228             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
2229             WDTE(I,0)=WDTE(I,MDME(IDC,1))
2230             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
2231           ENDIF
2232   430   CONTINUE
2233
2234       ELSEIF(KFLA.EQ.KEXCIT+2) THEN
2235 C...u* excited quark.
2236         FAC=(SH/RTCM(41)**2)*SHR
2237         DO 440 I=1,MDCY(KC,3)
2238           IDC=I+MDCY(KC,2)-1
2239           IF(MDME(IDC,1).LT.0) GOTO 440
2240           RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
2241           RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
2242           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 440
2243           WID2=1D0
2244           IF(I.EQ.1) THEN
2245 C...u* -> g + u.
2246             WDTP(I)=FAC*AS*RTCM(45)**2/3D0
2247             WID2=1D0
2248           ELSEIF(I.EQ.2) THEN
2249 C...u* -> gamma + u.
2250             QF=RTCM(43)/2D0+RTCM(44)/6D0
2251             WDTP(I)=FAC*AEM*QF**2/4D0
2252             WID2=1D0
2253           ELSEIF(I.EQ.3) THEN
2254 C...u* -> Z0 + u.
2255             QF=RTCM(43)*XW1/2D0-RTCM(44)*XW/6D0
2256             WDTP(I)=FAC*AEM*QF**2/(8D0*XW*XW1)*
2257      &      (1D0-RM1)**2*(2D0+RM1)
2258             WID2=WIDS(23,2)
2259           ELSEIF(I.EQ.4) THEN
2260 C...u* -> W+ + d.
2261             WDTP(I)=FAC*AEM*RTCM(43)**2/(16D0*XW)*
2262      &      (1D0-RM1)**2*(2D0+RM1)
2263             IF(KFLR.GT.0) WID2=WIDS(24,2)
2264             IF(KFLR.LT.0) WID2=WIDS(24,3)
2265           ENDIF
2266           WDTP(I)=FUDGE*WDTP(I)
2267           WDTP(0)=WDTP(0)+WDTP(I)
2268           IF(MDME(IDC,1).GT.0) THEN
2269             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
2270             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
2271             WDTE(I,0)=WDTE(I,MDME(IDC,1))
2272             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
2273           ENDIF
2274   440   CONTINUE
2275
2276       ELSEIF(KFLA.EQ.KEXCIT+11) THEN
2277 C...e* excited lepton.
2278         FAC=(SH/RTCM(41)**2)*SHR
2279         DO 450 I=1,MDCY(KC,3)
2280           IDC=I+MDCY(KC,2)-1
2281           IF(MDME(IDC,1).LT.0) GOTO 450
2282           RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
2283           RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
2284           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 450
2285           WID2=1D0
2286           IF(I.EQ.1) THEN
2287 C...e* -> gamma + e.
2288             QF=-RTCM(43)/2D0-RTCM(44)/2D0
2289             WDTP(I)=FAC*AEM*QF**2/4D0
2290             WID2=1D0
2291           ELSEIF(I.EQ.2) THEN
2292 C...e* -> Z0 + e.
2293             QF=-RTCM(43)*XW1/2D0+RTCM(44)*XW/2D0
2294             WDTP(I)=FAC*AEM*QF**2/(8D0*XW*XW1)*
2295      &      (1D0-RM1)**2*(2D0+RM1)
2296             WID2=WIDS(23,2)
2297           ELSEIF(I.EQ.3) THEN
2298 C...e* -> W- + nu.
2299             WDTP(I)=FAC*AEM*RTCM(43)**2/(16D0*XW)*
2300      &      (1D0-RM1)**2*(2D0+RM1)
2301             IF(KFLR.GT.0) WID2=WIDS(24,3)
2302             IF(KFLR.LT.0) WID2=WIDS(24,2)
2303           ENDIF
2304           WDTP(I)=FUDGE*WDTP(I)
2305           WDTP(0)=WDTP(0)+WDTP(I)
2306           IF(MDME(IDC,1).GT.0) THEN
2307             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
2308             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
2309             WDTE(I,0)=WDTE(I,MDME(IDC,1))
2310             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
2311           ENDIF
2312   450   CONTINUE
2313
2314       ELSEIF(KFLA.EQ.KEXCIT+12) THEN
2315 C...nu*_e excited neutrino.
2316         FAC=(SH/RTCM(41)**2)*SHR
2317         DO 460 I=1,MDCY(KC,3)
2318           IDC=I+MDCY(KC,2)-1
2319           IF(MDME(IDC,1).LT.0) GOTO 460
2320           RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
2321           RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
2322           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 460
2323           WID2=1D0
2324           IF(I.EQ.1) THEN
2325 C...nu*_e -> Z0 + nu*_e.
2326             QF=RTCM(43)*XW1/2D0+RTCM(44)*XW/2D0
2327             WDTP(I)=FAC*AEM*QF**2/(8D0*XW*XW1)*
2328      &      (1D0-RM1)**2*(2D0+RM1)
2329             WID2=WIDS(23,2)
2330           ELSEIF(I.EQ.2) THEN
2331 C...nu*_e -> W+ + e.
2332             WDTP(I)=FAC*AEM*RTCM(43)**2/(16D0*XW)*
2333      &      (1D0-RM1)**2*(2D0+RM1)
2334             IF(KFLR.GT.0) WID2=WIDS(24,2)
2335             IF(KFLR.LT.0) WID2=WIDS(24,3)
2336           ENDIF
2337           WDTP(I)=FUDGE*WDTP(I)
2338           WDTP(0)=WDTP(0)+WDTP(I)
2339           IF(MDME(IDC,1).GT.0) THEN
2340             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
2341             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
2342             WDTE(I,0)=WDTE(I,MDME(IDC,1))
2343             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
2344           ENDIF
2345   460   CONTINUE
2346
2347       ELSEIF(KFLA.EQ.KDIMEN+39) THEN
2348 C...G* (graviton resonance):
2349         FAC=(PARP(50)**2/PARU(1))*SHR
2350         DO 470 I=1,MDCY(KC,3)
2351           IDC=I+MDCY(KC,2)-1
2352           IF(MDME(IDC,1).LT.0) GOTO 470
2353           RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
2354           RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
2355           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 470
2356           WID2=1D0
2357           IF(I.LE.8) THEN
2358 C...G* -> q + qbar
2359             FCOF=3D0*RADC
2360             IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF*
2361      &      PYHFTH(SH,SH*RM1,1D0)
2362             WDTP(I)=FAC*FCOF*SQRT(MAX(0D0,1D0-4D0*RM1))**3*
2363      &      (1D0+8D0*RM1/3D0)/320D0
2364             IF(I.EQ.6) WID2=WIDS(6,1)
2365             IF(I.EQ.7.OR.I.EQ.8) WID2=WIDS(I,1)
2366           ELSEIF(I.LE.16) THEN
2367 C...G* -> l+ + l-, nu + nubar
2368             FCOF=1D0
2369             WDTP(I)=FAC*SQRT(MAX(0D0,1D0-4D0*RM1))**3*
2370      &      (1D0+8D0*RM1/3D0)/320D0
2371             IF(I.EQ.15.OR.I.EQ.16) WID2=WIDS(2+I,1)
2372           ELSEIF(I.EQ.17) THEN
2373 C...G* -> g + g.
2374             WDTP(I)=FAC/20D0
2375           ELSEIF(I.EQ.18) THEN
2376 C...G* -> gamma + gamma.
2377             WDTP(I)=FAC/160D0
2378           ELSEIF(I.EQ.19) THEN
2379 C...G* -> Z0 + Z0.
2380             WDTP(I)=FAC*SQRT(MAX(0D0,1D0-4D0*RM1))*(13D0/12D0+
2381      &      14D0*RM1/3D0+4D0*RM1**2)/160D0
2382             WID2=WIDS(23,1)
2383           ELSEIF(I.EQ.20) THEN
2384 C...G* -> W+ + W-.
2385             WDTP(I)=FAC*SQRT(MAX(0D0,1D0-4D0*RM1))*(13D0/12D0+
2386      &      14D0*RM1/3D0+4D0*RM1**2)/80D0
2387             WID2=WIDS(24,1)
2388           ENDIF
2389           WDTP(I)=FUDGE*WDTP(I)
2390           WDTP(0)=WDTP(0)+WDTP(I)
2391           IF(MDME(IDC,1).GT.0) THEN
2392             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
2393             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
2394             WDTE(I,0)=WDTE(I,MDME(IDC,1))
2395             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
2396           ENDIF
2397   470   CONTINUE
2398
2399       ELSEIF(KFLA.EQ.9900012.OR.KFLA.EQ.9900014.OR.KFLA.EQ.9900016) THEN
2400 C...nu_eR, nu_muR, nu_tauR: righthanded Majorana neutrinos.
2401         PMWR=MAX(1.001D0*SHR,PMAS(PYCOMP(9900024),1))
2402         FAC=(AEM**2/(768D0*PARU(1)*XW**2))*SHR**5/PMWR**4
2403         DO 480 I=1,MDCY(KC,3)
2404           IDC=I+MDCY(KC,2)-1
2405           IF(MDME(IDC,1).LT.0) GOTO 480
2406           PM1=PMAS(PYCOMP(KFDP(IDC,1)),1)
2407           PM2=PMAS(PYCOMP(KFDP(IDC,2)),1)
2408           PM3=PMAS(PYCOMP(KFDP(IDC,3)),1)
2409           IF(PM1+PM2+PM3.GE.SHR) GOTO 480
2410           WID2=1D0
2411           IF(I.LE.9) THEN
2412 C...nu_lR -> l- qbar q'
2413             FCOF=3D0*RADC*VCKM((I-1)/3+1,MOD(I-1,3)+1)
2414             IF(MOD(I,3).EQ.0) WID2=WIDS(6,2)
2415           ELSEIF(I.LE.18) THEN
2416 C...nu_lR -> l+ q qbar'
2417             FCOF=3D0*RADC*VCKM((I-10)/3+1,MOD(I-10,3)+1)
2418             IF(MOD(I-9,3).EQ.0) WID2=WIDS(6,3)
2419           ELSE
2420 C...nu_lR -> l- l'+ nu_lR' + charge conjugate.
2421             FCOF=1D0
2422             WID2=WIDS(PYCOMP(KFDP(IDC,3)),2)
2423           ENDIF
2424           X=(PM1+PM2+PM3)/SHR
2425           FX=1D0-8D0*X**2+8D0*X**6-X**8-24D0*X**4*LOG(X)
2426           Y=(SHR/PMWR)**2
2427           FY=(12D0*(1D0-Y)*LOG(1D0-Y)+12D0*Y-6D0*Y**2-2D0*Y**3)/Y**4
2428           WDTP(I)=FAC*FCOF*FX*FY
2429           WDTP(I)=FUDGE*WDTP(I)
2430           WDTP(0)=WDTP(0)+WDTP(I)
2431           IF(MDME(IDC,1).GT.0) THEN
2432             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
2433             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
2434             WDTE(I,0)=WDTE(I,MDME(IDC,1))
2435             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
2436           ENDIF
2437   480   CONTINUE
2438
2439       ELSEIF(KFLA.EQ.9900023) THEN
2440 C...Z_R0:
2441         FAC=(AEM/(48D0*XW*XW1*(1D0-2D0*XW)))*SHR
2442         DO 490 I=1,MDCY(KC,3)
2443           IDC=I+MDCY(KC,2)-1
2444           IF(MDME(IDC,1).LT.0) GOTO 490
2445           RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
2446           RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
2447           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 490
2448           WID2=1D0
2449           SYMMET=1D0
2450           IF(I.LE.6) THEN
2451 C...Z_R0 -> q + qbar
2452             EF=KCHG(I,1)/3D0
2453             AF=SIGN(1D0,EF+0.1D0)*(1D0-2D0*XW)
2454             VF=SIGN(1D0,EF+0.1D0)-4D0*EF*XW
2455             FCOF=3D0*RADC
2456             IF(I.EQ.6) WID2=WIDS(6,1)
2457           ELSEIF(I.EQ.7.OR.I.EQ.10.OR.I.EQ.13) THEN
2458 C...Z_R0 -> l+ + l-
2459             AF=-(1D0-2D0*XW)
2460             VF=-1D0+4D0*XW
2461             FCOF=1D0
2462           ELSEIF(I.EQ.8.OR.I.EQ.11.OR.I.EQ.14) THEN
2463 C...Z0 -> nu_L + nu_Lbar, assumed Majorana.
2464             AF=-2D0*XW
2465             VF=0D0
2466             FCOF=1D0
2467             SYMMET=0.5D0
2468           ELSEIF(I.LE.15) THEN
2469 C...Z0 -> nu_R + nu_R, assumed Majorana.
2470             AF=2D0*XW1
2471             VF=0D0
2472             FCOF=1D0
2473             WID2=WIDS(PYCOMP(KFDP(IDC,1)),1)
2474             SYMMET=0.5D0
2475           ENDIF
2476           WDTP(I)=FAC*FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))*
2477      &    SQRT(MAX(0D0,1D0-4D0*RM1))*SYMMET
2478           WDTP(I)=FUDGE*WDTP(I)
2479           WDTP(0)=WDTP(0)+WDTP(I)
2480           IF(MDME(IDC,1).GT.0) THEN
2481             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
2482             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
2483             WDTE(I,0)=WDTE(I,MDME(IDC,1))
2484             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
2485           ENDIF
2486   490   CONTINUE
2487
2488       ELSEIF(KFLA.EQ.9900024) THEN
2489 C...W_R+/-:
2490         FAC=(AEM/(24D0*XW))*SHR
2491         DO 500 I=1,MDCY(KC,3)
2492           IDC=I+MDCY(KC,2)-1
2493           IF(MDME(IDC,1).LT.0) GOTO 500
2494           RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
2495           RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
2496           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 500
2497           WID2=1D0
2498           IF(I.LE.9) THEN
2499 C...W_R+/- -> q + qbar'
2500             FCOF=3D0*RADC*VCKM((I-1)/3+1,MOD(I-1,3)+1)
2501             IF(KFLR.GT.0) THEN
2502               IF(MOD(I,3).EQ.0) WID2=WIDS(6,2)
2503             ELSE
2504               IF(MOD(I,3).EQ.0) WID2=WIDS(6,3)
2505             ENDIF
2506           ELSEIF(I.LE.12) THEN
2507 C...W_R+/- -> l+/- + nu_R
2508             FCOF=1D0
2509           ENDIF
2510           WDTP(I)=FAC*FCOF*(2D0-RM1-RM2-(RM1-RM2)**2)*
2511      &    SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))
2512           WDTP(I)=FUDGE*WDTP(I)
2513           WDTP(0)=WDTP(0)+WDTP(I)
2514           IF(MDME(IDC,1).GT.0) THEN
2515             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
2516             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
2517             WDTE(I,0)=WDTE(I,MDME(IDC,1))
2518             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
2519           ENDIF
2520   500  CONTINUE
2521
2522       ELSEIF(KFLA.EQ.9900041) THEN
2523 C...H_L++/--:
2524         FAC=(1D0/(8D0*PARU(1)))*SHR
2525         DO 510 I=1,MDCY(KC,3)
2526           IDC=I+MDCY(KC,2)-1
2527           IF(MDME(IDC,1).LT.0) GOTO 510
2528           RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
2529           RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
2530           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 510
2531           WID2=1D0
2532           IF(I.LE.6) THEN
2533 C...H_L++/-- -> l+/- + l'+/-
2534             FCOF=PARP(180+3*((IABS(KFDP(IDC,1))-11)/2)+
2535      &      (IABS(KFDP(IDC,2))-9)/2)**2
2536             IF(KFDP(IDC,1).NE.KFDP(IDC,2)) FCOF=2D0*FCOF
2537           ELSEIF(I.EQ.7) THEN
2538 C...H_L++/-- -> W_L+/- + W_L+/-
2539             FCOF=0.5D0*PARP(190)**4*PARP(192)**2/PMAS(24,1)**2*
2540      &      (3D0*RM1+0.25D0/RM1-1D0)
2541             WID2=WIDS(24,4+(1-KFLS)/2)
2542           ENDIF
2543           WDTP(I)=FAC*FCOF*
2544      &    SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))
2545           WDTP(I)=FUDGE*WDTP(I)
2546           WDTP(0)=WDTP(0)+WDTP(I)
2547           IF(MDME(IDC,1).GT.0) THEN
2548             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
2549             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
2550             WDTE(I,0)=WDTE(I,MDME(IDC,1))
2551             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
2552           ENDIF
2553   510   CONTINUE
2554
2555       ELSEIF(KFLA.EQ.9900042) THEN
2556 C...H_R++/--:
2557         FAC=(1D0/(8D0*PARU(1)))*SHR
2558         DO 520 I=1,MDCY(KC,3)
2559           IDC=I+MDCY(KC,2)-1
2560           IF(MDME(IDC,1).LT.0) GOTO 520
2561           RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
2562           RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
2563           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 520
2564           WID2=1D0
2565           IF(I.LE.6) THEN
2566 C...H_R++/-- -> l+/- + l'+/-
2567             FCOF=PARP(180+3*((IABS(KFDP(IDC,1))-11)/2)+
2568      &      (IABS(KFDP(IDC,2))-9)/2)**2
2569             IF(KFDP(IDC,1).NE.KFDP(IDC,2)) FCOF=2D0*FCOF
2570           ELSEIF(I.EQ.7) THEN
2571 C...H_R++/-- -> W_R+/- + W_R+/-
2572             FCOF=PARP(191)**2*(3D0*RM1+0.25D0/RM1-1D0)
2573             WID2=WIDS(PYCOMP(9900024),4+(1-KFLS)/2)
2574           ENDIF
2575           WDTP(I)=FAC*FCOF*
2576      &    SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))
2577           WDTP(I)=FUDGE*WDTP(I)
2578           WDTP(0)=WDTP(0)+WDTP(I)
2579           IF(MDME(IDC,1).GT.0) THEN
2580             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
2581             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
2582             WDTE(I,0)=WDTE(I,MDME(IDC,1))
2583             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
2584           ENDIF
2585   520  CONTINUE
2586
2587       ENDIF
2588       MINT(61)=0
2589       MINT(62)=0
2590       MINT(63)=0
2591       RETURN
2592       END