hto_hbb_cp Module Reference

Functions/Subroutines
real *8 function	hto_sshh (x)
real *8 function	hto_shh (muhr, scal, rgh)

Function/Subroutine Documentation

hto_shh()

real*8 function hto_hbb_cp::hto_shh	(	real*8	muhr,
		real*8	scal,
		real*8	rgh
	)

Definition at line 3611 of file CALLING_cpHTO.f.

       USE hto_ferbos
       USE hto_a_cmplx
       USE hto_aux_hcp
       USE hto_aux_hbb
       USE hto_units
       USE hto_acmplx_pro
       USE hto_acmplx_rat
       USE hto_full_ln
       USE hto_ln_2_riemann
       USE hto_masses
       USE hto_set_phys_const
       USE hto_riemann
       USE hto_optcp
       USE hto_olas
       USE hto_common_niels
       USE hto_qcd
       USE hto_cmplx_rootz
*
       IMPLICIT NONE
*
       INTEGER nc,iz
       real*8 hto_shh,muhr,rgh,muhs,scal,scals,p2,xm0,str,sti,ewc,
     #        sconv,asmur,emc,emb,emt,as_NLO,rmbs,rmcs,rmss,
     #        crmbs,crmcs,lcxb,lcxc,lcxbs,lcxcs,lclxb,lclxc,qcdtop,neg
       real*8, dimension(2) :: axm0
       real*8, dimension(2,2) :: axms
       real*8, dimension(3,2,2) :: bmcb
       real*8, dimension(8,2,2) :: bmcf
       real*8, dimension(1,2,2) :: bmct
       real*8, dimension(3,2) :: bm0b,coefbb
       real*8, dimension(8,2) :: bm0f,coefbf
       real*8, dimension(1,2) :: bm0t,coefbt
       real*8, dimension(2) :: sh,shs,clh,b0sumb,b0sumf,cxp,ksumb,
     #         ksumf,coefB1,coefB2,coefB3,coefB4,coefB5,coefB6,coefB7,
     #         coefB8,coefB9,coefB10,coefB11,coefB12,ab2,ab3,
     #         totalf,totalt,totalb,total,b0sumt,ksumt,xms,
     #         b0part,cpt,ccxt,deltag,sww0,coefW1,coefW2,
     #         ksumw,ccxts,cctsi,shi,clt,cxhw,cstsi,csmcts,cltmw,
     #         b0sumw,sww,DW,b0sumw1,b0sumw2,cmxw,clmw,cxtw,
     #         kfmsb,ktmsb,kbmsb,nloqcd,runbc,ttqcd,wccxt,wclt,wccxts,
     #         wcxtw,wcltmw,ascal
*     
       INTERFACE
        SUBROUTINE hto_initalphas(asord,FR2,MUR,asmur,emc,emb,emt)
        USE hto_dzpar 
        IMPLICIT NONE
        INTEGER asord
        real*8 fr2,mur,asmur,emc,emb,emt,hto_findalphasr0
        EXTERNAL hto_findalphasr0
        END SUBROUTINE hto_initalphas
       END INTERFACE
*
       INTERFACE
        FUNCTION hto_alphas(MUR)
        USE hto_nffix  
        USE hto_varflv 
        USE hto_frrat  
        USE hto_asinp  
        USE hto_asfthr 
        IMPLICIT NONE
        real*8 mur,hto_alphas
        END FUNCTION hto_alphas
       END INTERFACE
*
       INTERFACE
        FUNCTION hto_quarkqcd(scal,psi,ps0i,xmsi,xm0i,type) 
     #                        RESULT(value)
        USE hto_riemann
        USE hto_acmplx_pro
        USE hto_acmplx_rat
        USE hto_cmplx_root
        USE hto_cmplx_rootz
        USE hto_cmplx_srs_root
        USE hto_ln_2_riemann
        USE hto_full_ln
        USE hto_sp_fun
        USE hto_units
        IMPLICIT NONE
        INTEGER type
        real*8 scal,ps0i,xm0i
        real*8, dimension(2) :: value,psi,xmsi
        END FUNCTION hto_quarkqcd
       END INTERFACE
*
       muhs= muhr*muhr
       scals= scal*scal
*
       asmur= 0.12018d0
       emc= 1.4d0
       emb= 4.75d0
       emt= mt
       iz= 1
       CALL hto_initalphas(iz,one,mz,asmur,emc,emb,emt)
       als= hto_alphas(scal)
       as_nlo= als/pi
*
       runbc= hto_run_bc(scal)
       crmbs= runbc(2)*runbc(2)
       crmcs= runbc(1)*runbc(1)         
*
       lcxb= crmbs/scals
       lcxc= crmcs/scals
*
       lcxbs= lcxb*lcxb
       lcxcs= lcxc*lcxc
       lclxb= log(lcxb)
       lclxc= log(lcxc)
*
       IF(gtop == 1) THEN
        imt= g_f/(8.d0*sqrt(2.d0)*pi)*(mt*mt-mw*mw)**2*
     #      (mt*mt+2.d0*mw*mw)/mt**3
       ELSEIF(gtop == 0) THEN 
        imt= 0.d0
       ELSE
        imt= yimt
       ENDIF
*
       str= mt*mt-0.25d0*imt*imt
       sti= -mt*imt
       cpt(1)= str
       cpt(2)= sti
       wccxt= cpt/scals
       wccxts= wccxt.cp.wccxt
       ccxt= cpt/scals
       ccxts= ccxt.cp.ccxt
*
       cctsi= co.cq.ccts
       cstsi= co.cq.csts
       csmcts= csts-ccts
       cmxw= -cxw
*
       clmw= cmxw(1).fln.cmxw(2)
       clmw(2)= clmw(2)-2.d0*pi
*
       sh(1)= muhs/scals
       sh(2)= -muhr*rgh/scals
*
       cxhw= sh-cxw 
       shs= sh.cp.sh
       shi= co.cq.sh
*
       clh= sh(1).fln.sh(2)
       clt= ccxt(1).fln.ccxt(2)
       wclt= wccxt(1).fln.wccxt(2)
       cxtw= ccxt-cxw
       wcxtw= wccxt-cxw
       cltmw= cxtw(1).fln.cxtw(2)
       wcltmw= wcxtw(1).fln.wcxtw(2)
*
* w
       coefb1= (12.d0*cxw-4.d0*sh+(shs.cq.cxw))/64.d0
*
* z
       coefb2= (-4.d0*(sh.cq.ccts)+(shs.cq.cxw)+
     #         12.d0*(cxw.cq.cctq))/128.d0
*  
* h
       coefb3= 9.d0/128.d0*(shs.cq.cxw)
*
* top
       coefb4= -3.d0/32.d0*((4.d0*ccxt-sh).cp.(ccxt.cq.cxw))
*
* light fermions
*
       coefb5= -3.d0/32.d0*((4.d0*co*lcxb-sh).cq.cxw)*lcxb
*
       coefb6= -1.d0/32.d0*((4.d0*co*cxtau-sh).cq.cxw)*cxtau
*
       coefb7= -3.d0/32.d0*((4.d0*co*lcxc-sh).cq.cxw)*lcxc
*
       coefb8= -1.d0/32.d0*((4.d0*co*cxmu-sh).cq.cxw)*cxmu
*
       coefb9= -3.d0/32.d0*((4.d0*co*cxs-sh).cq.cxw)*cxs
*
       coefb10= -3.d0/32.d0*((4.d0*co*cxd-sh).cq.cxw)*cxd
*
       coefb11= -3.d0/32.d0*((4.d0*co*cxu-sh).cq.cxw)*cxu
*
       coefb12= -1.d0/32.d0*((4.d0*co*cxe-sh).cq.cxw)*cxe
*
       cxp(1)= muhs
       cxp(2)= -muhr*rgh
       p2= muhs
*
       IF(ifb.eq.0) THEN
*
        xms(1)= swr
        xms(2)= swi
        xm0= mw
        b0part= hto_b0af_em(scal,cxp,p2,xms,xm0)
        b0sumb= (coefb1.cp.b0part)
        xms(1)= szr
        xms(2)= szi
        xm0= mz
        b0part= hto_b0af_em(scal,cxp,p2,xms,xm0)
        b0sumb= b0sumb+(coefb2.cp.b0part)
        xms(1)= muhs
        xms(2)= -muhr*rgh
        xm0= muhr
        b0part= hto_b0af_em(scal,cxp,p2,xms,xm0)
        b0sumb= b0sumb+(coefb3.cp.b0part)
*
        xms(1:2)= crmbs*co(1:2)
        xm0= sqrt(crmbs)
        b0part= hto_b0af_em(scal,cxp,p2,xms,xm0)
        b0sumf= (coefb5.cp.b0part)
        xms(1:2)= mtl*mtl*co(1:2)
        xm0= mtl
        b0part= hto_b0af_em(scal,cxp,p2,xms,xm0)
        b0sumf= b0sumf+(coefb6.cp.b0part)
        xms(1:2)= crmcs*co(1:2)
        xm0= sqrt(crmcs)
        b0part= hto_b0af_em(scal,cxp,p2,xms,xm0)
        b0sumf= b0sumf+(coefb7.cp.b0part)
        xms(1:2)= mm*mm*co(1:2)
        xm0= mm
        b0part= hto_b0af_em(scal,cxp,p2,xms,xm0)
        b0sumf= b0sumf+(coefb8.cp.b0part)
        xms(1:2)= msq*msq*co(1:2)
        xm0= msq
        b0part= hto_b0af_em(scal,cxp,p2,xms,xm0)
        b0sumf= b0sumf+(coefb9.cp.b0part)
        xms(1:2)= mdq*mdq*co(1:2)
        xm0= mdq
        b0part= hto_b0af_em(scal,cxp,p2,xms,xm0)
        b0sumf= b0sumf+(coefb10.cp.b0part)
        xms(1:2)= muq*muq*co(1:2)
        xm0= muq
        b0part= hto_b0af_em(scal,cxp,p2,xms,xm0)
        b0sumf= b0sumf+(coefb11.cp.b0part)
        xms(1:2)= me*me*co(1:2)
        xm0= me
        b0part= hto_b0af_em(scal,cxp,p2,xms,xm0)
        b0sumf= b0sumf+(coefb12.cp.b0part)
*
        xms(1:2)= cpt(1:2)
        xm0= mt
        b0part= hto_b0af_em(scal,cxp,p2,xms,xm0)
        b0sumt= (coefb4.cp.b0part)
*
        iz= 0
        xms(1:2)= crmbs*co(1:2)
        xm0= sqrt(crmbs)
        nloqcd= crmbs*hto_quarkqcd(scal,cxp,p2,xms,xm0,iz)
        xms(1:2)= crmcs*co(1:2)
        xm0= sqrt(crmcs)
        nloqcd= nloqcd+crmcs*hto_quarkqcd(scal,cxp,p2,xms,xm0,iz)
        IF(qcdc==0) nloqcd= 0.d0
*
        xms(1:2)= cpt(1:2)
        xm0= mt
        iz= 1
        ttqcd= hto_quarkqcd(scal,cxp,p2,xms,xm0,iz)
        ttqcd= cpt.cp.ttqcd
        IF(qcdc==0) ttqcd= 0.d0
*
       ELSEIF(ifb.eq.1) THEN
*
        xms(1:2)= crmbs*co(1:2)
        xm0= sqrt(crmbs)
        b0part= hto_b0af_em(scal,cxp,p2,xms,xm0)
        b0sumf= (coefb5.cp.b0part)
        xms(1:2)= mtl*mtl*co(1:2)
        xm0= mtl
        b0part= hto_b0af_em(scal,cxp,p2,xms,xm0)
        b0sumf= b0sumf+(coefb6.cp.b0part)
        xms(1:2)= crmcs*co(1:2)
        xm0= sqrt(crmcs)
        b0part= hto_b0af_em(scal,cxp,p2,xms,xm0)
        b0sumf= b0sumf+(coefb7.cp.b0part)
        xms(1:2)= mm*mm*co(1:2)
        xm0= mm
        b0part= hto_b0af_em(scal,cxp,p2,xms,xm0)
        b0sumf= b0sumf+(coefb8.cp.b0part)
        xms(1:2)= msq*msq*co(1:2)
        xm0= msq
        b0part= hto_b0af_em(scal,cxp,p2,xms,xm0)
        b0sumf= b0sumf+(coefb9.cp.b0part)
        xms(1:2)= mdq*mdq*co(1:2)
        xm0= mdq
        b0part= hto_b0af_em(scal,cxp,p2,xms,xm0)
        b0sumf= b0sumf+(coefb10.cp.b0part)
        xms(1:2)= muq*muq*co(1:2)
        xm0= muq
        b0part=hto_b0af_em(scal,cxp,p2,xms,xm0)
        b0sumf= b0sumf+(coefb11.cp.b0part)
        xms(1:2)= me*me*co(1:2)
        xm0= me
        b0part= hto_b0af_em(scal,cxp,p2,xms,xm0)
        b0sumf= b0sumf+(coefb12.cp.b0part)
*
        iz= 0
        xms(1:2)= crmbs*co(1:2)
        xm0= sqrt(crmbs)
        nloqcd= crmbs*hto_quarkqcd(scal,cxp,p2,xms,xm0,iz)
        xms(1:2)= crmcs*co(1:2)
        xm0= sqrt(crmcs)
        nloqcd= nloqcd+crmcs*hto_quarkqcd(scal,cxp,p2,xms,xm0,iz)
        IF(qcdc==0) nloqcd= 0.d0
*
       ELSEIF(ifb.eq.2) THEN
*
        xms(1:2)= cpt(1:2)
        xm0= mt
        b0part= hto_b0af_em(scal,cxp,p2,xms,xm0)
        b0sumt= (coefb4.cp.b0part)
*    
        xms(1:2)= cpt(1:2)
        xm0= mt
        iz= 1
        ttqcd= hto_quarkqcd(scal,cxp,p2,xms,xm0,iz)
        ttqcd= cpt.cp.ttqcd
        IF(qcdc==0) ttqcd= 0.d0
*
       ELSEIF(ifb.eq.3) THEN
*
        xms(1)= swr
        xms(2)= swi
        xm0= mw
        b0part= hto_b0af_em(scal,cxp,p2,xms,xm0)
        b0sumb= (coefb1.cp.b0part)
        xms(1)= szr
        xms(2)= szi
        xm0= mz
        b0part= hto_b0af_em(scal,cxp,p2,xms,xm0)
        b0sumb= b0sumb+(coefb2.cp.b0part)
        xms(1)= muhs
        xms(2)= -muhr*rgh
        xm0= muhr
        b0part= hto_b0af_em(scal,cxp,p2,xms,xm0)
        b0sumb= b0sumb+(coefb3.cp.b0part)
*
       ENDIF
*
       IF(ifb.eq.0.or.ifb.eq.1) THEN
        ksumf= -(sh.cq.cxw)*(cxe*clxe+cxmu*clxmu+
     #        cxtau*clxtau+3.d0*(cxd*clxd+cxs*clxs+lcxb*lclxb+
     #        cxu*clxu+lcxc*lclxc))/32.d0+
     #        cxwi*(cxes+cxmus+cxtaus+3.d0*(
     #        cxds+cxss+lcxbs+cxus+lcxcs))/8.d0
       ENDIF
       IF(ifb.eq.0.or.ifb.eq.2) THEN
        ksumt= 3.d0/32.d0*(4.d0*((ccxt.cq.cxw).cp.ccxt)
     #        -(clt.cp.((sh.cq.cxw).cp.ccxt)))
       ENDIF
*
       IF(ifb.eq.0.or.ifb.eq.3) THEN
*
        ksumb= (-2.d0*((2.d0*co+cctsi+3.d0*(sh.cq.cxw)).cp.sh)
     #  -(clcts.cp.((6.d0*cctsi-(sh.cq.cxw)).cp.sh))
     #  +3.d0*(clw.cp.((4.d0*co+2.d0*cctsi-(sh.cq.cxw)).cp.sh))
     #  -3.d0*(clh.cp.(shs.cq.cxw)))/128.d0
*
       ENDIF
*
       ewc= 4.d0*sqrt(2.d0)*g_f/pis
       sconv= muhs/scals
*
       IF(ifb.eq.0.or.ifb.eq.1) THEN
        totalf= b0sumf+ksumf
       ENDIF
*
       IF(ifb.eq.0.or.ifb.eq.2) THEN
        totalt= b0sumt+ksumt
*
        neg= ewc*(swr*totalt(2)+swi*totalt(1))/sconv
     #      -as_NLO*g_f/(sqrt(2.d0)*pis)*
     #      (sh(1)*ttqcd(2)+sh(2)*ttqcd(1))/sconv
*
        IF(neg < 0.d0) THEN
         totalt= 0.d0
         qcdtop= 0.d0
         pcnt= -1
        ELSE
         qcdtop= as_nlo*g_f/(sqrt(2.d0)*pis)*
     #          (sh(1)*ttqcd(2)+sh(2)*ttqcd(1))/sconv
         pcnt= 1
        ENDIF       
*
       ENDIF
*
       IF(ifb.eq.0.or.ifb.eq.3) THEN
        totalb= b0sumb+ksumb
        IF((swr*totalb(2)+swi*totalb(1)) < 0.d0) THEN
         totalb= 0.d0
         pcnt= -1
        ELSE
         pcnt= 1
        ENDIF
       ENDIF 
*
       total= totalf+totalt+totalb
*
*--- w self energies
*
       deltag= 6.d0*co+0.5d0*(((7.d0*co-4.d0*csts).cq.csts).cp.clcts)
*
       sww0= -(38.d0*cxw+6.d0*wccxt+7.d0*sh
     # -48.d0*(((wccxt.cq.sh).cq.cxw).cp.wccxt)+8.d0*(cxw.cq.sh))/128.d0
     # -3.d0/64.d0*((cxw-sh+(cxws.cq.cxhw)).cp.clh)
     # +3.d0/32.d0*(((co-4.d0*((wccxt.cq.sh).cq.cxw).cp.wccxt)).cp.wclt)
     # +((((8.d0*co-17.d0*cstsi+3.d0*cctsi).cp.cxw)
     # -6.d0*((cxw.cq.sh).cq.cctq)).cp.clcts)/64.d0
     # -((cxw.cq.sh).cq.cctq)/32.d0+5.d0/128.d0*(cxw.cq.ccts)
*
       coefw1= -(((8.d0*co-(sh.cq.cxw)).cp.sh)*sh
     #       -4.d0*((-12.d0*cxw+7.d0*sh).cp.cxw))/192.d0
*
       coefw2= -((cxws.cq.csmcts).cp.(416.d0*co-192.d0*csts 
     #       -((132.d0*co-((12.d0*co+cctsi).cq.ccts)).cq.ccts)))/192.d0
*
       cxp(1)= swr
       cxp(2)= swi
       p2= mw*mw
*
       axms(1,1)= swr
       axms(1,2)= swi
       axm0(1)= mw
       axms(2,1)= muhs
       axms(2,2)= -muhr*rgh
       axm0(2)= muhr
       b0part= hto_b021_dm_cp(scal,cxp,p2,axms,axm0)
       b0sumw1= (coefw1.cp.b0part)
       b0sumw= (coefw1.cp.b0part)
*
       axms(1,1)= szr
       axms(1,2)= szi
       axm0(1)= mz
       axms(2,1)= swr
       axms(2,2)= swi
       axm0(2)= mw
       b0part= hto_b021_dm_cp(scal,cxp,p2,axms,axm0)
       b0sumw2= (coefw2.cp.b0part)
       b0sumw= b0sumw+(coefw2.cp.b0part)
*
       ksumw= -12.d0*((cxw
     #    -0.5d0*((3.d0*co-(wccxts.cq.cxws)).cp.wccxt)).cp.wcltmw)
     #    -((24.d0*cxw-((14.d0*co-(sh.cq.cxw)).cp.sh)).cp.clh)
     #    +((36.d0*cxw-14.d0*sh-18.d0*((co-4.d0*(wccxt.cq.sh)).cp.wccxt)
     #    +(shs.cq.cxw)).cp.clw)
     #    -6.d0*(((2.d0*co+((cxwi-12.d0*shi).cp.wccxt)).cp.wccxt)
     #    +1.d0/6.d0*((15.d0*co-(sh.cq.cxw)).cp.sh)
     #    +2.d0/9.d0*((97.d0*co+9.d0*(cxw.cq.sh)).cp.cxw))
     #    +(((cxw.cq.ccts).cp.(co-6.d0*(cxw.cq.sh))).cq.ccts)
     #    -2.d0*(((cxw.cq.csmcts).cp.clcts).cp.(62.d0*co
     #    -48.d0*csts-5.d0*cctsi))
     #    -18.d0*(((cxws.cq.sh).cq.cctq).cp.clcts)
     #    -72.d0*((wclt.cp.wccxts).cp.(shi-1.d0/12.d0*(wccxt.cq.cxws)))
     #    +23.d0*(cxw.cq.ccts)
*
       ksumw= ksumw/192.d0+3.d0/16.d0*(cxw.cp.(clw-clmw))
*
       sww= b0sumw+ksumw
*
       dw= (-sww+sww0)/sconv+deltag/16.d0
*       dw= 0.d0
*
       IF(ifb.eq.0) THEN
        hto_shh= rgh/muhr*
     #       (1.d0+EWC*(swr*DW(1)-swi*DW(2)))
     #       -EWC*(swr*total(2)+swi*total(1))/sconv
     #       +as_NLO*g_f/(sqrt(2.d0)*pis)*
     #       (sh(1)*nloqcd(2)+sh(2)*nloqcd(1))/sconv
     #       +qcdtop
*
       ELSEIF(ifb.eq.1) THEN
        hto_shh= rgh/muhr*
     #       (1.d0+EWC*(swr*DW(1)-swi*DW(2)))
     #       -EWC*(swr*totalf(2)+swi*totalf(1))/sconv
     #       +as_NLO*g_f/(sqrt(2.d0)*pis)*
     #       (sh(1)*nloqcd(2)+sh(2)*nloqcd(1))/sconv
       ELSEIF(ifb.eq.2) THEN
        hto_shh= rgh/muhr*
     #       (1.d0+EWC*(swr*DW(1)-swi*DW(2)))
     #       -EWC*(swr*totalt(2)+swi*totalt(1))/sconv
     #       +qcdtop
       ELSEIF(ifb.eq.3) THEN
        hto_shh= rgh/muhr*
     #       (1.d0+EWC*(swr*DW(1)-swi*DW(2)))
     #       -EWC*(swr*totalb(2)+swi*totalb(1))/sconv
       ENDIF
*
       RETURN
*

hto_sshh()

real*8 function hto_hbb_cp::hto_sshh

(

real*8, intent(in)

x

)

Definition at line 3590 of file CALLING_cpHTO.f.

      USE hto_aux_hcp
*
      IMPLICIT NONE
*
c I've commented the following line and added the other twos (Carlo Oleari)
c      REAL*8 HTO_SSHH,rgh,muc,scalc,x
      real*8 hto_sshh,rgh,muc,scalc
      real*8, INTENT(IN)  :: x
*
      muc= muhcp
      scalc= scalec
      rgh= x*muc
*
      hto_sshh= hto_shh(muc,scalc,rgh)
*
      RETURN