pyhiwidt.f

Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file pyhiwidt.f

    
C*********************************************************************  
    
      SUBROUTINE pyhiwidt(KFLR,RMAS,WDTP,WDTE)    
    
C...Calculates full and partial widths of resonances.   
      common/ludat1/mstu(200),paru(200),mstj(200),parj(200) 
      SAVE /ludat1/ 
      common/ludat2/kchg(500,3),pmas(500,4),parf(2000),vckm(4,4)    
      SAVE /ludat2/ 
      common/ludat3/mdcy(500,3),mdme(2000,2),brat(2000),kfdp(2000,5)    
      SAVE /ludat3/ 
      common/pyhipars/mstp(200),parp(200),msti(200),pari(200) 
      SAVE /pyhipars/ 
      common/pyhiint1/mint(400),vint(400) 
      SAVE /pyhiint1/ 
      common/pyhiint4/widp(21:40,0:40),wide(21:40,0:40),wids(21:40,3) 
      SAVE /pyhiint4/ 
      dimension wdtp(0:40),wdte(0:40,0:5)   
    
C...Some common constants.  
      kfla=iabs(kflr)   
      sqm=rmas**2   
      as=ulalps(sqm)    
      aem=paru(101) 
      xw=paru(102)  
      radc=1.+as/paru(1)    
    
C...Reset width information.    
      DO 100 i=0,40 
      wdtp(i)=0.    
      DO 100 j=0,5  
  100 wdte(i,j)=0.  
    
      IF(kfla.EQ.21) THEN   
C...QCD:    
        DO 110 i=1,mdcy(21,3)   
        idc=i+mdcy(21,2)-1  
        rm1=(pmas(iabs(kfdp(idc,1)),1)/rmas)**2 
        rm2=(pmas(iabs(kfdp(idc,2)),1)/rmas)**2 
        IF(sqrt(rm1)+sqrt(rm2).GT.1..OR.mdme(idc,1).LT.0) goto 110  
        IF(i.LE.8) THEN 
C...QCD -> q + qb   
          wdtp(i)=(1.+2.*rm1)*sqrt(max(0.,1.-4.*rm1))   
          wid2=1.   
        ENDIF   
        wdtp(0)=wdtp(0)+wdtp(i) 
        IF(mdme(idc,1).GT.0) THEN   
          wdte(i,mdme(idc,1))=wdtp(i)*wid2  
          wdte(0,mdme(idc,1))=wdte(0,mdme(idc,1))+wdte(i,mdme(idc,1))   
          wdte(i,0)=wdte(i,mdme(idc,1)) 
          wdte(0,0)=wdte(0,0)+wdte(i,0) 
        ENDIF   
  110   CONTINUE    
    
      ELSEIF(kfla.EQ.23) THEN   
C...Z0: 
        IF(mint(61).EQ.1) THEN  
          ei=kchg(iabs(mint(15)),1)/3.  
          ai=sign(1.,ei)    
          vi=ai-4.*ei*xw    
          sqmz=pmas(23,1)**2    
          gzmz=pmas(23,2)*pmas(23,1)    
          ggi=ei**2 
          gzi=ei*vi/(8.*xw*(1.-xw))*sqm*(sqm-sqmz)/ 
     &    ((sqm-sqmz)**2+gzmz**2)   
          zzi=(vi**2+ai**2)/(16.*xw*(1.-xw))**2*sqm**2/ 
     &    ((sqm-sqmz)**2+gzmz**2)   
          IF(mstp(43).EQ.1) THEN    
C...Only gamma* production included 
            gzi=0.  
            zzi=0.  
          ELSEIF(mstp(43).EQ.2) THEN    
C...Only Z0 production included 
            ggi=0.  
            gzi=0.  
          ENDIF 
        ELSEIF(mint(61).EQ.2) THEN  
          vint(111)=0.  
          vint(112)=0.  
          vint(114)=0.  
        ENDIF   
        DO 120 i=1,mdcy(23,3)   
        idc=i+mdcy(23,2)-1  
        rm1=(pmas(iabs(kfdp(idc,1)),1)/rmas)**2 
        rm2=(pmas(iabs(kfdp(idc,2)),1)/rmas)**2 
        IF(sqrt(rm1)+sqrt(rm2).GT.1..OR.mdme(idc,1).LT.0) goto 120  
        IF(i.LE.8) THEN 
C...Z0 -> q + qb    
          ef=kchg(i,1)/3.   
          af=sign(1.,ef+0.1)    
          vf=af-4.*ef*xw    
          IF(mint(61).EQ.0) THEN    
            wdtp(i)=3.*(vf**2*(1.+2.*rm1)+af**2*(1.-4.*rm1))*   
     &      sqrt(max(0.,1.-4.*rm1))*radc    
          ELSEIF(mint(61).EQ.1) THEN    
            wdtp(i)=3.*((ggi*ef**2+gzi*ef*vf+zzi*vf**2)*    
     &      (1.+2.*rm1)+zzi*af**2*(1.-4.*rm1))* 
     &      sqrt(max(0.,1.-4.*rm1))*radc    
          ELSEIF(mint(61).EQ.2) THEN    
            ggf=3.*ef**2*(1.+2.*rm1)*sqrt(max(0.,1.-4.*rm1))*radc   
            gzf=3.*ef*vf*(1.+2.*rm1)*sqrt(max(0.,1.-4.*rm1))*radc   
            zzf=3.*(vf**2*(1.+2.*rm1)+af**2*(1.-4.*rm1))*   
     &      sqrt(max(0.,1.-4.*rm1))*radc    
          ENDIF 
          wid2=1.   
        ELSEIF(i.LE.16) THEN    
C...Z0 -> l+ + l-, nu + nub 
          ef=kchg(i+2,1)/3. 
          af=sign(1.,ef+0.1)    
          vf=af-4.*ef*xw    
          wdtp(i)=(vf**2*(1.+2.*rm1)+af**2*(1.-4.*rm1))*    
     &    sqrt(max(0.,1.-4.*rm1))   
          IF(mint(61).EQ.0) THEN    
            wdtp(i)=(vf**2*(1.+2.*rm1)+af**2*(1.-4.*rm1))*  
     &      sqrt(max(0.,1.-4.*rm1)) 
          ELSEIF(mint(61).EQ.1) THEN    
            wdtp(i)=((ggi*ef**2+gzi*ef*vf+zzi*vf**2)*   
     &      (1.+2.*rm1)+zzi*af**2*(1.-4.*rm1))* 
     &      sqrt(max(0.,1.-4.*rm1)) 
          ELSEIF(mint(61).EQ.2) THEN    
            ggf=ef**2*(1.+2.*rm1)*sqrt(max(0.,1.-4.*rm1))   
            gzf=ef*vf*(1.+2.*rm1)*sqrt(max(0.,1.-4.*rm1))   
            zzf=(vf**2*(1.+2.*rm1)+af**2*(1.-4.*rm1))*  
     &      sqrt(max(0.,1.-4.*rm1)) 
          ENDIF 
          wid2=1.   
        ELSE    
C...Z0 -> H+ + H-   
          cf=2.*(1.-2.*xw)  
          IF(mint(61).EQ.0) THEN    
            wdtp(i)=0.25*cf**2*(1.-4.*rm1)*sqrt(max(0.,1.-4.*rm1))  
          ELSEIF(mint(61).EQ.1) THEN    
            wdtp(i)=0.25*(ggi+gzi*cf+zzi*cf**2)*(1.-4.*rm1)*    
     &      sqrt(max(0.,1.-4.*rm1)) 
          ELSEIF(mint(61).EQ.2) THEN    
            ggf=0.25*(1.-4.*rm1)*sqrt(max(0.,1.-4.*rm1))    
            gzf=0.25*cf*(1.-4.*rm1)*sqrt(max(0.,1.-4.*rm1)) 
            zzf=0.25*cf**2*(1.-4.*rm1)*sqrt(max(0.,1.-4.*rm1))  
          ENDIF 
          wid2=wids(37,1)   
        ENDIF   
        wdtp(0)=wdtp(0)+wdtp(i) 
        IF(mdme(idc,1).GT.0) THEN   
          wdte(i,mdme(idc,1))=wdtp(i)*wid2  
          wdte(0,mdme(idc,1))=wdte(0,mdme(idc,1))+wdte(i,mdme(idc,1))   
          wdte(i,0)=wdte(i,mdme(idc,1)) 
          wdte(0,0)=wdte(0,0)+wdte(i,0) 
          vint(111)=vint(111)+ggf*wid2  
          vint(112)=vint(112)+gzf*wid2  
          vint(114)=vint(114)+zzf*wid2  
        ENDIF   
  120   CONTINUE    
        IF(mstp(43).EQ.1) THEN  
C...Only gamma* production included 
          vint(112)=0.  
          vint(114)=0.  
        ELSEIF(mstp(43).EQ.2) THEN  
C...Only Z0 production included 
          vint(111)=0.  
          vint(112)=0.  
        ENDIF   
    
      ELSEIF(kfla.EQ.24) THEN   
C...W+/-:   
        DO 130 i=1,mdcy(24,3)   
        idc=i+mdcy(24,2)-1  
        rm1=(pmas(iabs(kfdp(idc,1)),1)/rmas)**2 
        rm2=(pmas(iabs(kfdp(idc,2)),1)/rmas)**2 
        IF(sqrt(rm1)+sqrt(rm2).GT.1..OR.mdme(idc,1).LT.0) goto 130  
        IF(i.LE.16) THEN    
C...W+/- -> q + qb' 
          wdtp(i)=3.*(2.-rm1-rm2-(rm1-rm2)**2)* 
     &    sqrt(max(0.,(1.-rm1-rm2)**2-4.*rm1*rm2))* 
     &    vckm((i-1)/4+1,mod(i-1,4)+1)*radc 
          wid2=1.   
        ELSE    
C...W+/- -> l+/- + nu   
          wdtp(i)=(2.-rm1-rm2-(rm1-rm2)**2)*    
     &    sqrt(max(0.,(1.-rm1-rm2)**2-4.*rm1*rm2))  
          wid2=1.   
        ENDIF   
        wdtp(0)=wdtp(0)+wdtp(i) 
        IF(mdme(idc,1).GT.0) THEN   
          wdte(i,mdme(idc,1))=wdtp(i)*wid2  
          wdte(0,mdme(idc,1))=wdte(0,mdme(idc,1))+wdte(i,mdme(idc,1))   
          wdte(i,0)=wdte(i,mdme(idc,1)) 
          wdte(0,0)=wdte(0,0)+wdte(i,0) 
        ENDIF   
  130   CONTINUE    
    
      ELSEIF(kfla.EQ.25) THEN   
C...H0: 
        DO 170 i=1,mdcy(25,3)   
        idc=i+mdcy(25,2)-1  
        rm1=(pmas(iabs(kfdp(idc,1)),1)/rmas)**2 
        rm2=(pmas(iabs(kfdp(idc,2)),1)/rmas)**2 
        IF(sqrt(rm1)+sqrt(rm2).GT.1..OR.mdme(idc,1).LT.0) goto 170  
        IF(i.LE.8) THEN 
C...H0 -> q + qb    
          wdtp(i)=3.*rm1*(1.-4.*rm1)*sqrt(max(0.,1.-4.*rm1))*radc   
          wid2=1.   
        ELSEIF(i.LE.12) THEN    
C...H0 -> l+ + l-   
          wdtp(i)=rm1*(1.-4.*rm1)*sqrt(max(0.,1.-4.*rm1))   
          wid2=1.   
        ELSEIF(i.EQ.13) THEN    
C...H0 -> g + g; quark loop contribution only   
          etare=0.  
          etaim=0.  
          DO 140 j=1,2*mstp(1)  
          eps=(2.*pmas(j,1)/rmas)**2    
          IF(eps.LE.1.) THEN    
            IF(eps.GT.1.e-4) THEN   
              root=sqrt(1.-eps) 
              rln=log((1.+root)/(1.-root))  
            ELSE    
              rln=log(4./eps-2.)    
            ENDIF   
            phire=0.25*(rln**2-paru(1)**2)  
            phiim=0.5*paru(1)*rln   
          ELSE  
            phire=-(asin(1./sqrt(eps)))**2  
            phiim=0.    
          ENDIF 
          etare=etare+0.5*eps*(1.+(eps-1.)*phire)   
          etaim=etaim+0.5*eps*(eps-1.)*phiim    
  140     CONTINUE  
          eta2=etare**2+etaim**2    
          wdtp(i)=(as/paru(1))**2*eta2  
          wid2=1.   
        ELSEIF(i.EQ.14) THEN    
C...H0 -> gamma + gamma; quark, charged lepton and W loop contributions 
          etare=0.  
          etaim=0.  
          DO 150 j=1,3*mstp(1)+1    
          IF(j.LE.2*mstp(1)) THEN   
            ej=kchg(j,1)/3. 
            eps=(2.*pmas(j,1)/rmas)**2  
          ELSEIF(j.LE.3*mstp(1)) THEN   
            jl=2*(j-2*mstp(1))-1    
            ej=kchg(10+jl,1)/3. 
            eps=(2.*pmas(10+jl,1)/rmas)**2  
          ELSE  
            eps=(2.*pmas(24,1)/rmas)**2 
          ENDIF 
          IF(eps.LE.1.) THEN    
            IF(eps.GT.1.e-4) THEN   
              root=sqrt(1.-eps) 
              rln=log((1.+root)/(1.-root))  
            ELSE    
              rln=log(4./eps-2.)    
            ENDIF   
            phire=0.25*(rln**2-paru(1)**2)  
            phiim=0.5*paru(1)*rln   
          ELSE  
            phire=-(asin(1./sqrt(eps)))**2  
            phiim=0.    
          ENDIF 
          IF(j.LE.2*mstp(1)) THEN   
            etare=etare+0.5*3.*ej**2*eps*(1.+(eps-1.)*phire)    
            etaim=etaim+0.5*3.*ej**2*eps*(eps-1.)*phiim 
          ELSEIF(j.LE.3*mstp(1)) THEN   
            etare=etare+0.5*ej**2*eps*(1.+(eps-1.)*phire)   
            etaim=etaim+0.5*ej**2*eps*(eps-1.)*phiim    
          ELSE  
            etare=etare-0.5-0.75*eps*(1.+(eps-2.)*phire)    
            etaim=etaim+0.75*eps*(eps-2.)*phiim 
          ENDIF 
  150     CONTINUE  
          eta2=etare**2+etaim**2    
          wdtp(i)=(aem/paru(1))**2*0.5*eta2 
          wid2=1.   
        ELSEIF(i.EQ.15) THEN    
C...H0 -> gamma + Z0; quark, charged lepton and W loop contributions    
          etare=0.  
          etaim=0.  
          DO 160 j=1,3*mstp(1)+1    
          IF(j.LE.2*mstp(1)) THEN   
            ej=kchg(j,1)/3. 
            aj=sign(1.,ej+0.1)  
            vj=aj-4.*ej*xw  
            eps=(2.*pmas(j,1)/rmas)**2  
            epsp=(2.*pmas(j,1)/pmas(23,1))**2   
          ELSEIF(j.LE.3*mstp(1)) THEN   
            jl=2*(j-2*mstp(1))-1    
            ej=kchg(10+jl,1)/3. 
            aj=sign(1.,ej+0.1)  
            vj=ai-4.*ej*xw  
            eps=(2.*pmas(10+jl,1)/rmas)**2  
            epsp=(2.*pmas(10+jl,1)/pmas(23,1))**2   
          ELSE  
            eps=(2.*pmas(24,1)/rmas)**2 
            epsp=(2.*pmas(24,1)/pmas(23,1))**2  
          ENDIF 
          IF(eps.LE.1.) THEN    
            root=sqrt(1.-eps)   
            IF(eps.GT.1.e-4) THEN   
              rln=log((1.+root)/(1.-root))  
            ELSE    
              rln=log(4./eps-2.)    
            ENDIF   
            phire=0.25*(rln**2-paru(1)**2)  
            phiim=0.5*paru(1)*rln   
            psire=-(1.+0.5*root*rln)    
            psiim=0.5*paru(1)*root  
          ELSE  
            phire=-(asin(1./sqrt(eps)))**2  
            phiim=0.    
            psire=-(1.+sqrt(eps-1.)*asin(1./sqrt(eps))) 
            psiim=0.    
          ENDIF 
          IF(epsp.LE.1.) THEN   
            root=sqrt(1.-epsp)  
            IF(epsp.GT.1.e-4) THEN  
              rln=log((1.+root)/(1.-root))  
            ELSE    
              rln=log(4./epsp-2.)   
            ENDIF   
            phirep=0.25*(rln**2-paru(1)**2) 
            phiimp=0.5*paru(1)*rln  
            psirep=-(1.+0.5*root*rln)   
            psiimp=0.5*paru(1)*root 
          ELSE  
            phirep=-(asin(1./sqrt(epsp)))**2    
            phiimp=0.   
            psirep=-(1.+sqrt(epsp-1.)*asin(1./sqrt(epsp)))  
            psiimp=0.   
          ENDIF 
          fxyre=eps*epsp/(8.*(eps-epsp))*(1.-eps*epsp/(eps-epsp)*(phire-    
     &    phirep)+2.*eps/(eps-epsp)*(psire-psirep)) 
          fxyim=eps*epsp/(8.*(eps-epsp))*(-eps*epsp/(eps-epsp)*(phiim-  
     &    phiimp)+2.*eps/(eps-epsp)*(psiim-psiimp)) 
          f1re=eps*epsp/(2.*(eps-epsp))*(phire-phirep)  
          f1im=eps*epsp/(2.*(eps-epsp))*(phiim-phiimp)  
          IF(j.LE.2*mstp(1)) THEN   
            etare=etare-3.*ej*vj*(fxyre-0.25*f1re)  
            etaim=etaim-3.*ej*vj*(fxyim-0.25*f1im)  
          ELSEIF(j.LE.3*mstp(1)) THEN   
            etare=etare-ej*vj*(fxyre-0.25*f1re) 
            etaim=etaim-ej*vj*(fxyim-0.25*f1im) 
          ELSE  
            etare=etare-sqrt(1.-xw)*(((1.+2./eps)*xw/sqrt(1.-xw)-   
     &      (5.+2./eps))*fxyre+(3.-xw/sqrt(1.-xw))*f1re)    
            etaim=etaim-sqrt(1.-xw)*(((1.+2./eps)*xw/sqrt(1.-xw)-   
     &      (5.+2./eps))*fxyim+(3.-xw/sqrt(1.-xw))*f1im)    
          ENDIF 
  160     CONTINUE  
          eta2=etare**2+etaim**2    
          wdtp(i)=(aem/paru(1))**2*(1.-(pmas(23,1)/rmas)**2)**3/xw*eta2 
          wid2=wids(23,2)   
        ELSE    
C...H0 -> Z0 + Z0, W+ + W-  
          wdtp(i)=(1.-4.*rm1+12.*rm1**2)*sqrt(max(0.,1.-4.*rm1))/   
     &    (2.*(18-i))   
          wid2=wids(7+i,1)  
        ENDIF   
        wdtp(0)=wdtp(0)+wdtp(i) 
        IF(mdme(idc,1).GT.0) THEN   
          wdte(i,mdme(idc,1))=wdtp(i)*wid2  
          wdte(0,mdme(idc,1))=wdte(0,mdme(idc,1))+wdte(i,mdme(idc,1))   
          wdte(i,0)=wdte(i,mdme(idc,1)) 
          wdte(0,0)=wdte(0,0)+wdte(i,0) 
        ENDIF   
  170   CONTINUE    
    
      ELSEIF(kfla.EQ.32) THEN   
C...Z'0:    
        IF(mint(61).EQ.1) THEN  
          ei=kchg(iabs(mint(15)),1)/3.  
          ai=sign(1.,ei)    
          vi=ai-4.*ei*xw    
          sqmz=pmas(23,1)**2    
          gzmz=pmas(23,2)*pmas(23,1)    
          api=sign(1.,ei)   
          vpi=api-4.*ei*xw  
          sqmzp=pmas(32,1)**2   
          gzpmzp=pmas(32,2)*pmas(32,1)  
          ggi=ei**2 
          gzi=ei*vi/(8.*xw*(1.-xw))*sqm*(sqm-sqmz)/ 
     &    ((sqm-sqmz)**2+gzmz**2)   
          gzpi=ei*vpi/(8.*xw*(1.-xw))*sqm*(sqm-sqmzp)/  
     &    ((sqm-sqmzp)**2+gzpmzp**2)    
          zzi=(vi**2+ai**2)/(16.*xw*(1.-xw))**2*sqm**2/ 
     &    ((sqm-sqmz)**2+gzmz**2)   
          zzpi=2.*(vi*vpi+ai*api)/(16.*xw*(1.-xw))**2*  
     &    sqm**2*((sqm-sqmz)*(sqm-sqmzp)+gzmz*gzpmzp)/  
     &    (((sqm-sqmz)**2+gzmz**2)*((sqm-sqmzp)**2+gzpmzp**2))  
          zpzpi=(vpi**2+api**2)/(16.*xw*(1.-xw))**2*sqm**2/ 
     &    ((sqm-sqmzp)**2+gzpmzp**2)    
          IF(mstp(44).EQ.1) THEN    
C...Only gamma* production included 
            gzi=0.  
            gzpi=0. 
            zzi=0.  
            zzpi=0. 
            zpzpi=0.    
          ELSEIF(mstp(44).EQ.2) THEN    
C...Only Z0 production included 
            ggi=0.  
            gzi=0.  
            gzpi=0. 
            zzpi=0. 
            zpzpi=0.    
          ELSEIF(mstp(44).EQ.3) THEN    
C...Only Z'0 production included    
            ggi=0.  
            gzi=0.  
            gzpi=0. 
            zzi=0.  
            zzpi=0. 
          ELSEIF(mstp(44).EQ.4) THEN    
C...Only gamma*/Z0 production included  
            gzpi=0. 
            zzpi=0. 
            zpzpi=0.    
          ELSEIF(mstp(44).EQ.5) THEN    
C...Only gamma*/Z'0 production included 
            gzi=0.  
            zzi=0.  
            zzpi=0. 
          ELSEIF(mstp(44).EQ.6) THEN    
C...Only Z0/Z'0 production included 
            ggi=0.  
            gzi=0.  
            gzpi=0. 
          ENDIF 
        ELSEIF(mint(61).EQ.2) THEN  
          vint(111)=0.  
          vint(112)=0.  
          vint(113)=0.  
          vint(114)=0.  
          vint(115)=0.  
          vint(116)=0.  
        ENDIF   
        DO 180 i=1,mdcy(32,3)   
        idc=i+mdcy(32,2)-1  
        rm1=(pmas(iabs(kfdp(idc,1)),1)/rmas)**2 
        rm2=(pmas(iabs(kfdp(idc,2)),1)/rmas)**2 
        IF(sqrt(rm1)+sqrt(rm2).GT.1..OR.mdme(idc,1).LT.0) goto 180  
        IF(i.LE.8) THEN 
C...Z'0 -> q + qb   
          ef=kchg(i,1)/3.   
          af=sign(1.,ef+0.1)    
          vf=af-4.*ef*xw    
          apf=sign(1.,ef+0.1)   
          vpf=apf-4.*ef*xw  
          IF(mint(61).EQ.0) THEN    
            wdtp(i)=3.*(vpf**2*(1.+2.*rm1)+apf**2*(1.-4.*rm1))* 
     &      sqrt(max(0.,1.-4.*rm1))*radc    
          ELSEIF(mint(61).EQ.1) THEN    
            wdtp(i)=3.*((ggi*ef**2+gzi*ef*vf+gzpi*ef*vpf+zzi*vf**2+ 
     &      zzpi*vf*vpf+zpzpi*vpf**2)*(1.+2.*rm1)+(zzi*af**2+   
     &      zzpi*af*apf+zpzpi*apf**2)*(1.-4.*rm1))* 
     &      sqrt(max(0.,1.-4.*rm1))*radc    
          ELSEIF(mint(61).EQ.2) THEN    
            ggf=3.*ef**2*(1.+2.*rm1)*sqrt(max(0.,1.-4.*rm1))*radc   
            gzf=3.*ef*vf*(1.+2.*rm1)*sqrt(max(0.,1.-4.*rm1))*radc   
            gzpf=3.*ef*vpf*(1.+2.*rm1)*sqrt(max(0.,1.-4.*rm1))*radc 
            zzf=3.*(vf**2*(1.+2.*rm1)+af**2*(1.-4.*rm1))*   
     &      sqrt(max(0.,1.-4.*rm1))*radc    
            zzpf=3.*(vf*vpf*(1.+2.*rm1)+af*apf*(1.-4.*rm1))*    
     &      sqrt(max(0.,1.-4.*rm1))*radc    
            zpzpf=3.*(vpf**2*(1.+2.*rm1)+apf**2*(1.-4.*rm1))*   
     &      sqrt(max(0.,1.-4.*rm1))*radc    
          ENDIF 
          wid2=1.   
        ELSE    
C...Z'0 -> l+ + l-, nu + nub    
          ef=kchg(i+2,1)/3. 
          af=sign(1.,ef+0.1)    
          vf=af-4.*ef*xw    
          apf=sign(1.,ef+0.1)   
          vpf=api-4.*ef*xw  
          IF(mint(61).EQ.0) THEN    
            wdtp(i)=(vpf**2*(1.+2.*rm1)+apf**2*(1.-4.*rm1))*    
     &      sqrt(max(0.,1.-4.*rm1)) 
          ELSEIF(mint(61).EQ.1) THEN    
            wdtp(i)=((ggi*ef**2+gzi*ef*vf+gzpi*ef*vpf+zzi*vf**2+    
     &      zzpi*vf*vpf+zpzpi*vpf**2)*(1.+2.*rm1)+(zzi*af**2+   
     &      zzpi*af*apf+zpzpi*apf**2)*(1.-4.*rm1))* 
     &      sqrt(max(0.,1.-4.*rm1)) 
          ELSEIF(mint(61).EQ.2) THEN    
            ggf=ef**2*(1.+2.*rm1)*sqrt(max(0.,1.-4.*rm1))   
            gzf=ef*vf*(1.+2.*rm1)*sqrt(max(0.,1.-4.*rm1))   
            gzpf=ef*vpf*(1.+2.*rm1)*sqrt(max(0.,1.-4.*rm1)) 
            zzf=(vf**2*(1.+2.*rm1)+af**2*(1.-4.*rm1))*  
     &      sqrt(max(0.,1.-4.*rm1)) 
            zzpf=(vf*vpf*(1.+2.*rm1)+af*apf*(1.-4.*rm1))*   
     &      sqrt(max(0.,1.-4.*rm1)) 
            zpzpf=(vpf**2*(1.+2.*rm1)+apf**2*(1.-4.*rm1))*  
     &      sqrt(max(0.,1.-4.*rm1)) 
          ENDIF 
          wid2=1.   
        ENDIF   
        wdtp(0)=wdtp(0)+wdtp(i) 
        IF(mdme(idc,1).GT.0) THEN   
          wdte(i,mdme(idc,1))=wdtp(i)*wid2  
          wdte(0,mdme(idc,1))=wdte(0,mdme(idc,1))+wdte(i,mdme(idc,1))   
          wdte(i,0)=wdte(i,mdme(idc,1)) 
          wdte(0,0)=wdte(0,0)+wdte(i,0) 
          vint(111)=vint(111)+ggf   
          vint(112)=vint(112)+gzf   
          vint(113)=vint(113)+gzpf  
          vint(114)=vint(114)+zzf   
          vint(115)=vint(115)+zzpf  
          vint(116)=vint(116)+zpzpf 
        ENDIF   
  180   CONTINUE    
        IF(mstp(44).EQ.1) THEN  
C...Only gamma* production included 
          vint(112)=0.  
          vint(113)=0.  
          vint(114)=0.  
          vint(115)=0.  
          vint(116)=0.  
        ELSEIF(mstp(44).EQ.2) THEN  
C...Only Z0 production included 
          vint(111)=0.  
          vint(112)=0.  
          vint(113)=0.  
          vint(115)=0.  
          vint(116)=0.  
        ELSEIF(mstp(44).EQ.3) THEN  
C...Only Z'0 production included    
          vint(111)=0.  
          vint(112)=0.  
          vint(113)=0.  
          vint(114)=0.  
          vint(115)=0.  
        ELSEIF(mstp(44).EQ.4) THEN  
C...Only gamma*/Z0 production included  
          vint(113)=0.  
          vint(115)=0.  
          vint(116)=0.  
        ELSEIF(mstp(44).EQ.5) THEN  
C...Only gamma*/Z'0 production included 
          vint(112)=0.  
          vint(114)=0.  
          vint(115)=0.  
        ELSEIF(mstp(44).EQ.6) THEN  
C...Only Z0/Z'0 production included 
          vint(111)=0.  
          vint(112)=0.  
          vint(113)=0.  
        ENDIF   
    
      ELSEIF(kfla.EQ.37) THEN   
C...H+/-:   
        DO 190 i=1,mdcy(37,3)   
        idc=i+mdcy(37,2)-1  
        rm1=(pmas(iabs(kfdp(idc,1)),1)/rmas)**2 
        rm2=(pmas(iabs(kfdp(idc,2)),1)/rmas)**2 
        IF(sqrt(rm1)+sqrt(rm2).GT.1..OR.mdme(idc,1).LT.0) goto 190  
        IF(i.LE.4) THEN 
C...H+/- -> q + qb' 
          wdtp(i)=3.*((rm1*paru(121)+rm2/paru(121))*    
     &    (1.-rm1-rm2)-4.*rm1*rm2)* 
     &    sqrt(max(0.,(1.-rm1-rm2)**2-4.*rm1*rm2))*radc 
          wid2=1.   
        ELSE    
C...H+/- -> l+/- + nu   
          wdtp(i)=((rm1*paru(121)+rm2/paru(121))*   
     &    (1.-rm1-rm2)-4.*rm1*rm2)* 
     &    sqrt(max(0.,(1.-rm1-rm2)**2-4.*rm1*rm2))  
          wid2=1.   
        ENDIF   
        wdtp(0)=wdtp(0)+wdtp(i) 
        IF(mdme(idc,1).GT.0) THEN   
          wdte(i,mdme(idc,1))=wdtp(i)*wid2  
          wdte(0,mdme(idc,1))=wdte(0,mdme(idc,1))+wdte(i,mdme(idc,1))   
          wdte(i,0)=wdte(i,mdme(idc,1)) 
          wdte(0,0)=wdte(0,0)+wdte(i,0) 
        ENDIF   
  190   CONTINUE    
    
      ELSEIF(kfla.EQ.40) THEN   
C...R:  
        DO 200 i=1,mdcy(40,3)   
        idc=i+mdcy(40,2)-1  
        rm1=(pmas(iabs(kfdp(idc,1)),1)/rmas)**2 
        rm2=(pmas(iabs(kfdp(idc,2)),1)/rmas)**2 
        IF(sqrt(rm1)+sqrt(rm2).GT.1..OR.mdme(idc,1).LT.0) goto 200  
        IF(i.LE.4) THEN 
C...R -> q + qb'    
          wdtp(i)=3.*radc   
          wid2=1.   
        ELSE    
C...R -> l+ + l'-   
          wdtp(i)=1.    
          wid2=1.   
        ENDIF   
        wdtp(0)=wdtp(0)+wdtp(i) 
        IF(mdme(idc,1).GT.0) THEN   
          wdte(i,mdme(idc,1))=wdtp(i)*wid2  
          wdte(0,mdme(idc,1))=wdte(0,mdme(idc,1))+wdte(i,mdme(idc,1))   
          wdte(i,0)=wdte(i,mdme(idc,1)) 
          wdte(0,0)=wdte(0,0)+wdte(i,0) 
        ENDIF   
  200   CONTINUE    
    
      ENDIF 
      mint(61)=0    
    
      RETURN    
      END