JHUGen MELA  JHUGen v7.5.6, MELA v2.4.2
Matrix element calculations as used in JHUGen.
Data Types | Modules | Functions/Subroutines | Variables
CALLING_cpHTO.f File Reference

Go to the source code of this file.

Data Types

interface  hto_acmplx_pro::operator(.cp.)
 
interface  hto_acmplx_rat::operator(.cq.)
 
interface  hto_linear_comb_c::operator(.lcc.)
 
interface  hto_real_lnz::operator(.rlnz.)
 
interface  hto_imag_lnz::operator(.ilnz.)
 
interface  hto_real_ln::operator(.rln.)
 
interface  hto_cmplx_ln::operator(.cln.)
 
interface  hto_full_ln::operator(.fln.)
 
interface  hto_ln_2_riemann::operator(.lnsrs.)
 
interface  hto_cmplx_srs_root::operator(.crsrs.)
 
interface  hto_cmplx_root::operator(.cr.)
 
interface  hto_cmplx_rootz::operator(.crz.)
 
interface  hto_linear_comb::operator(.lc.)
 

Modules

module  hto_aux_hcp
 
module  hto_masses
 
module  hto_puttime
 
module  hto_units
 
module  hto_riemann
 
module  hto_bernoulli
 
module  hto_ferbos
 
module  hto_aux_hbb
 
module  hto_optcp
 
module  hto_set_phys_const
 
module  hto_rootw
 
module  hto_transfmh
 
module  hto_acmplx_pro
 
module  hto_acmplx_rat
 
module  hto_linear_comb_c
 
module  hto_real_lnz
 
module  hto_imag_lnz
 
module  hto_real_ln
 
module  hto_cmplx_ln
 
module  hto_full_ln
 
module  hto_ln_2_riemann
 
module  hto_cmplx_srs_root
 
module  hto_cmplx_root
 
module  hto_cmplx_rootz
 
module  hto_common_niels
 
module  hto_kountac
 
module  hto_linear_comb
 
module  hto_sp_fun
 
module  hto_dzpar
 
module  hto_rzeta
 
module  hto_colour
 
module  hto_asinp
 
module  hto_aspar
 
module  hto_varflv
 
module  hto_nffix
 
module  hto_frrat
 
module  hto_asfthr
 
module  hto_betacom
 
module  hto_olas
 
module  hto_qcd
 
module  hto_a_cmplx
 
module  hto_root_find2
 
module  hto_hbb_cp
 
module  hto_solve_nonlin
 

Functions/Subroutines

subroutine hto_puttime::hto_timestamp ()
 
real *8 function, dimension(2) hto_acmplx_pro::cp (x, y)
 
real *8 function, dimension(2) hto_acmplx_rat::cq (x, y)
 
real *8 function, dimension(2) hto_linear_comb_c::lcc (c, x)
 
real *8 function hto_real_lnz::rlnz (x, y)
 
real *8 function hto_imag_lnz::ilnz (x, y)
 
real *8 function hto_real_ln::rln (x, ep)
 
real *8 function, dimension(2) hto_cmplx_ln::cln (x, ep)
 
real *8 function, dimension(2) hto_full_ln::fln (x, y)
 
real *8 function, dimension(2) hto_ln_2_riemann::lnsrs (x, y)
 
real *8 function, dimension(2) hto_cmplx_srs_root::crsrs (x, y)
 
real *8 function, dimension(2) hto_cmplx_root::cr (x, ep)
 
real *8 function, dimension(2) hto_cmplx_rootz::crz (x, y)
 
real *8 function hto_linear_comb::lc (c, x)
 
recursive real *8 function, dimension(6, 2) hto_sp_fun::hto_s_niels_up4 (x)
 
real *8 function, dimension(2) hto_sp_fun::hto_li2_srsz (x, y, unit)
 
real *8 function, dimension(2) hto_sp_fun::hto_li3_srsz (x, y, unit)
 
real *8 function, dimension(3, 2) hto_sp_fun::hto_poly_unit (theta)
 
real *8 function, dimension(2) hto_sp_fun::hto_li2 (x)
 
real *8 function, dimension(size(x)) hto_sp_fun::hto_li3 (x)
 
subroutine hto_sp_fun::hto_init_niels
 
real *8 function, dimension(2) hto_sp_fun::hto_cqlnx (arg)
 
real *8 function, dimension(2) hto_sp_fun::hto_cqlnomx (arg, omarg)
 
subroutine hto_initalphas (IORD, FR2, MUR, ASMUR, MC, MB, MT)
 
real *8 function hto_findalphasr0 (ASI)
 
subroutine hto_initalphasr0 (IORD, FR2, R0, ASI, MC, MB, MT)
 
real *8 function hto_alphas (MUR)
 
real *8 function hto_asnf1 (ASNF, LOGRH, NF)
 
subroutine hto_evnfthr (MC2, MB2, MT2)
 
real *8 function hto_as (R2, R20, AS0, NF)
 
subroutine hto_betafct
 
real *8 function hto_dzero (A0, B0, EPS, MAXF, F, MODE)
 
real *8 function, dimension(2) hto_olas::hto_b0af_em (scal, psi, ps0i, xmsi, xm0i)
 
real *8 function, dimension(2) hto_quarkqcd (scal, psi, ps0i, xmsi, xm0i, type)
 
real *8 function hto_qcd::hto_ralphas (rs0, rs, als)
 
real *8 function hto_qcd::hto_qcdlam (nf, als, rs, x1, x2, xacc)
 
real *8 function hto_qcd::hto_qcdscale (nf, als, rs, x)
 
real *8 function, dimension(2) hto_qcd::hto_run_bc (scal)
 
real *8 function hto_qcd::hto_rrunm (x1, x2, xacc, qm, als, rm1, rm2, fn)
 
real *8 function hto_qcd::hto_qcdmass (qm, als, rm1, rm2, fn, x)
 
real *8 function, dimension(2) hto_a_cmplx::hto_b021_dm_cp (scal, psi, ps0i, xmsi, xm0i)
 
real *8 function hto_root_find2::hto_zeroin (f, ax, bx, aerr, rerr)
 
real *8 function hto_hbb_cp::hto_sshh (x)
 
real *8 function hto_hbb_cp::hto_shh (muhr, scal, rgh)
 
subroutine hto_gridht (mass, evalue)
 
subroutine hto_fmmsplinesingleht (b, c, d, top, gdim)
 
subroutine hto_seval3singleht (u, b, c, d, top, gdim, f, fp, fpp, fppp)
 
subroutine hto_gridlow (mass, evalue)
 
subroutine hto_fmmsplinesinglel (b, c, d, top, gdim)
 
subroutine hto_seval3singlel (u, b, c, d, top, gdim, f, fp, fpp, fppp)
 
real *8 function, dimension(10, 2) hto_deriv (scal, rhm)
 
subroutine hto_pole (m, mhb, ghb)
 
subroutine hto_gh (muh, cpgh)
 
subroutine, public hto_solve_nonlin::hto_hbrd (HTO_FCN, n, x, fvec, epsfcn, tol, info, diag)
 
subroutine, public hto_solve_nonlin::hto_hybrd (HTO_FCN, n, x, fvec, xtol, maxfev, ml, mu, epsfcn, diag, mode, factor, nprint, info, nfev)
 
subroutine hto_solve_nonlin::hto_dogleg (n, r, lr, diag, qtb, delta, x, wa1, wa2)
 
subroutine hto_solve_nonlin::hto_fdjac1 (HTO_FCN, n, x, fvec, fjac, ldfjac, iflag, ml, mu, epsfcn, wa1, wa2)
 
subroutine hto_solve_nonlin::hto_qform (m, n, q, ldq, wa)
 
subroutine hto_solve_nonlin::hto_qrfac (m, n, a, lda, pivot, ipvt, lipvt, rdiag, acnorm, wa)
 
subroutine hto_solve_nonlin::hto_r1mpyq (m, n, a, lda, v, w)
 
subroutine hto_solve_nonlin::hto_r1updt (m, n, s, ls, u, v, w, sing)
 
real *8 function hto_solve_nonlin::hto_enorm (n, x)
 
subroutine hto_poles (m, nv)
 
subroutine hto_cpoles (n, xcp, fvcp, iflag)
 
real *8 function, dimension(2) hto_lquarkqcd (scal, psi, ps0i, xmsi, xm0i, type)
 
real *8 function, dimension(2) hto_lb0af_dm (scal, psi, ps0i, xmsi, xm0i)
 
real *8 function, dimension(2) hto_lb0af_em (scal, psi, ps0i, xmsi, xm0i)
 
real *8 function, dimension(2) hto_lb021_dm_cp (scal, psi, ps0i, xmsi, xm0i)
 
subroutine call_hto (mhiggs, mtop, mhb, ghb)
 

Variables

integer hto_aux_hcp::qcdc
 
integer hto_aux_hcp::pcnt
 
integer hto_aux_hcp::gtop
 
real *8 hto_aux_hcp::cxe
 
real *8 hto_aux_hcp::cxmu
 
real *8 hto_aux_hcp::cxtau
 
real *8 hto_aux_hcp::cxu
 
real *8 hto_aux_hcp::cxd
 
real *8 hto_aux_hcp::cxc
 
real *8 hto_aux_hcp::cxs
 
real *8 hto_aux_hcp::cxt
 
real *8 hto_aux_hcp::cxb
 
real *8 hto_aux_hcp::cxes
 
real *8 hto_aux_hcp::cxmus
 
real *8 hto_aux_hcp::cxtaus
 
real *8 hto_aux_hcp::cxus
 
real *8 hto_aux_hcp::cxds
 
real *8 hto_aux_hcp::cxcs
 
real *8 hto_aux_hcp::cxss
 
real *8 hto_aux_hcp::cxts
 
real *8 hto_aux_hcp::cxbs
 
real *8 hto_aux_hcp::clxe
 
real *8 hto_aux_hcp::clxmu
 
real *8 hto_aux_hcp::clxtau
 
real *8 hto_aux_hcp::clxu
 
real *8 hto_aux_hcp::clxd
 
real *8 hto_aux_hcp::clxc
 
real *8 hto_aux_hcp::clxs
 
real *8 hto_aux_hcp::clxt
 
real *8 hto_aux_hcp::clxb
 
real *8 hto_aux_hcp::muhcp
 
real *8 hto_aux_hcp::scalec
 
real *8 hto_aux_hcp::cxqs
 
real *8 hto_aux_hcp::cxq
 
real *8 hto_aux_hcp::cxls
 
real *8 hto_aux_hcp::cxl
 
real *8 hto_aux_hcp::cxtmb
 
real *8 hto_aux_hcp::cxtmbs
 
real *8 hto_aux_hcp::cxbi
 
real *8 hto_aux_hcp::cxtmbi
 
real *8 hto_aux_hcp::xq
 
real *8 hto_aux_hcp::cxtc
 
real *8 hto_aux_hcp::cxbc
 
real *8 hto_aux_hcp::yimt
 
real *8, dimension(2) hto_aux_hcp::cxwi
 
real *8, dimension(2) hto_aux_hcp::clcts
 
real *8, dimension(2) hto_aux_hcp::clwtb
 
real *8, dimension(2) hto_aux_hcp::cpw
 
real *8, dimension(2) hto_aux_hcp::cpz
 
real *8 hto_masses::mt
 
real *8, parameter hto_masses::m0 = 0.d0
 
real *8, parameter hto_masses::mw = 80.398d0
 
real *8, parameter hto_masses::mz = 91.1876d0
 
real *8, parameter hto_masses::me = 0.51099907d-3
 
real *8, parameter hto_masses::mm = 0.105658389d0
 
real *8, parameter hto_masses::mtl = 1.77684d0
 
real *8, parameter hto_masses::muq = 0.190d0
 
real *8, parameter hto_masses::mdq = 0.190d0
 
real *8, parameter hto_masses::mcq = 1.55d0
 
real *8, parameter hto_masses::msq = 0.190d0
 
real *8, parameter hto_masses::mbq = 4.69d0
 
real *8, parameter hto_masses::mb = 4.69d0
 
real *8, parameter hto_masses::mtiny = 1.d-10
 
real *8, parameter hto_masses::imw = 2.08872d0
 
real *8, parameter hto_masses::imz = 2.4952d0
 
real *8, parameter hto_masses::swr = mw*mw-imw*imw
 
real *8, parameter hto_masses::swi = -mw*imw*(1.d0-0.5d0*(imw*imw)/(mw*mw))
 
real *8, parameter hto_masses::szr = mz*mz-imz*imz
 
real *8, parameter hto_masses::szi = -mz*imz*(1.d0-0.5d0*(imz*imz)/(mz*mz))
 
integer, parameter hto_units::izer = 0
 
integer, parameter hto_units::ione = 1
 
integer, parameter hto_units::itwo = 2
 
real *8, parameter hto_units::eps = -1.d0
 
real *8, parameter hto_units::one = 1.d0
 
real *8, parameter hto_units::zero = 0.d0
 
real *8, parameter hto_units::qeps = 1.d-25
 
real *8, parameter hto_units::ez = 1.d-15
 
real *8, dimension(1:2) hto_units::co =(/1.d0,0.d0/)
 
real *8, dimension(1:2) hto_units::ci =(/0.d0,1.d0/)
 
real *8, dimension(1:2) hto_units::cz =(/0.d0,0.d0/)
 
real *8, parameter hto_riemann::pi = 3.141592653589793238462643d0
 
real *8, parameter hto_riemann::pis = pi*pi
 
real *8, parameter hto_riemann::piq = pis*pis
 
real *8, parameter hto_riemann::rz2 = 1.64493406684823d0
 
real *8, parameter hto_riemann::rz3 = 1.20205690315959d0
 
real *8, parameter hto_riemann::rz4 = 1.08232323371114d0
 
real *8, parameter hto_riemann::rz5 = 1.03692775514337d0
 
real *8, parameter hto_riemann::eg = 0.5772156649d0
 
real *8, parameter hto_riemann::ln_pi = 0.114472988584940016d1
 
real *8, dimension(0:18) hto_bernoulli::b_num =(/1.d0,-5.d-1,1.66666666666666d-1, 0.d0,-3.33333333333333d-2,0.d0,2.38095238095238d-2, 0.d0,-3.33333333333333d-2,0.d0,7.57575757575757d-2, 0.d0,-2.53113553113553d-1,0.d0,1.16666666666666d0, 0.d0,-7.09215686274509d0,0.d0,5.49711779448621d1/)
 
integer hto_ferbos::ifb
 
real *8 hto_aux_hbb::xb
 
real *8 hto_aux_hbb::xtop
 
real *8, dimension(2) hto_aux_hbb::cxw
 
real *8, dimension(2) hto_aux_hbb::clw
 
real *8, dimension(2) hto_aux_hbb::ccts
 
real *8, dimension(2) hto_aux_hbb::csts
 
real *8, dimension(2) hto_aux_hbb::cctq
 
real *8, dimension(2) hto_aux_hbb::cswt
 
real *8, dimension(2) hto_aux_hbb::cdwt
 
real *8, dimension(2) hto_aux_hbb::cdzt
 
real *8, dimension(2) hto_aux_hbb::cxws
 
real *8, dimension(2) hto_aux_hbb::cxwc
 
real *8, dimension(2) hto_aux_hbb::cxz
 
real *8, dimension(2) hto_aux_hbb::rcmw
 
real *8, dimension(2) hto_aux_hbb::cctvi
 
character(len=3) hto_optcp::ocp
 
real *8 hto_set_phys_const::alpha_0
 
real *8 hto_set_phys_const::g_f
 
real *8 hto_set_phys_const::g_w
 
real *8 hto_set_phys_const::als
 
real *8 hto_set_phys_const::alpha_s_mh
 
real *8 hto_set_phys_const::alpha_s_kmh
 
real *8 hto_set_phys_const::imt
 
integer hto_rootw::inc
 
real *8 hto_transfmh::tmuh
 
real *8, dimension(3, 0:15) hto_common_niels::plr
 
real *8, dimension(3, 0:15) hto_common_niels::plr_4
 
integer hto_kountac::kp
 
integer hto_kountac::km
 
integer hto_dzpar::iordc
 
real *8 hto_dzpar::fr2c
 
real *8 hto_dzpar::murc
 
real *8 hto_dzpar::asmurc
 
real *8 hto_dzpar::mcc
 
real *8 hto_dzpar::mbc
 
real *8 hto_dzpar::mtc
 
real *8 hto_dzpar::r0c
 
real *8, dimension(6) hto_rzeta::zeta
 
real *8 hto_colour::cf
 
real *8 hto_colour::ca
 
real *8 hto_colour::tr
 
real *8 hto_asinp::as0
 
real *8 hto_asinp::m20
 
integer hto_aspar::naord
 
integer hto_aspar::nastps
 
integer hto_varflv::ivfns
 
integer hto_nffix::nff
 
real *8 hto_frrat::logfr
 
real *8 hto_asfthr::asc
 
real *8 hto_asfthr::m2c
 
real *8 hto_asfthr::asb
 
real *8 hto_asfthr::m2b
 
real *8 hto_asfthr::ast
 
real *8 hto_asfthr::m2t
 
real *8, dimension(3:6) hto_betacom::beta0
 
real *8, dimension(3:6) hto_betacom::beta1
 
real *8, dimension(3:6) hto_betacom::beta2
 
real *8, dimension(3:6) hto_betacom::beta3
 

Function/Subroutine Documentation

◆ call_hto()

subroutine call_hto ( real*8  mhiggs,
real*8  mtop,
real*8  mhb,
real*8  ghb 
)

Definition at line 7656 of file CALLING_cpHTO.f.

7656  USE hto_masses
7657  USE hto_aux_hcp
7658  USE hto_puttime
7659  IMPLICIT NONE
7660  real*8 mhiggs,mtop,mhb,ghb
7661 *
7662  qcdc= 1
7663  gtop= 1
7664 *
7665 * your choice for G_top [GeV] (requires gtop = 2)
7666 *
7667  yimt= 0.d0
7668 *
7669 * top-quark mass
7670 *
7671  mt= mtop
7672  CALL hto_pole(mhiggs,mhb,ghb)
7673 *
7674  RETURN
7675 *

◆ hto_alphas()

real*8 function hto_alphas ( real*8  MUR)

Definition at line 2269 of file CALLING_cpHTO.f.

2269  USE hto_nffix
2270  USE hto_varflv
2271  USE hto_frrat
2272  USE hto_asinp
2273  USE hto_asfthr
2274 *
2275  IMPLICIT NONE
2276  INTEGER NF
2277 * REAL*8 M2,MUR,R2,ASI,ASF,R20,R2T,R2B,R2C,AS,HTO_ALPHAS
2278  real*8 m2,mur,r2,asi,asf,r20,r2t,r2b,r2c,hto_alphas
2279  real*8, parameter :: pi= 3.1415 9265358979d0
2280 *
2281  INTERFACE
2282  FUNCTION hto_as(R2,R20,AS0,NF)
2283  USE hto_aspar
2284  USE hto_betacom
2285  IMPLICIT NONE
2286  INTEGER NF
2287  real*8 r2,r20,as0,hto_as
2288  END FUNCTION hto_as
2289  END INTERFACE
2290 *
2291 * ..Input common blocks
2292 *
2293 
2294  r2 = mur**2
2295  m2 = r2 * exp(+logfr)
2296  IF(ivfns .EQ. 0) THEN
2297 *
2298 * Fixed number of flavours
2299 *
2300  nf = nff
2301  r20 = m20 * r2/m2
2302  asi = as0
2303  asf = hto_as(r2,r20,as0,nf)
2304 *
2305  ELSE
2306 *
2307 * ..Variable number of flavours
2308 *
2309  IF(m2 .GT. m2t) THEN
2310  nf = 6
2311  r2t = m2t * r2/m2
2312  asi = ast
2313  asf = hto_as(r2,r2t,ast,nf)
2314 *
2315  ELSE IF(m2 .GT. m2b) THEN
2316  nf = 5
2317  r2b = m2b * r2/m2
2318  asi = asb
2319  asf = hto_as(r2,r2b,asb,nf)
2320 *
2321  ELSE IF(m2 .GT. m2c) THEN
2322  nf = 4
2323  r2c = m2c * r2/m2
2324  asi = asc
2325  asf = hto_as(r2,r2c,asc,nf)
2326 *
2327  ELSE
2328  nf = 3
2329  r20 = m20 * r2/m2
2330  asi = as0
2331  asf = hto_as(r2,r20,as0,nf)
2332 *
2333  ENDIF
2334 *
2335  ENDIF
2336 *
2337 * ..Final value of alpha_s
2338 *
2339  hto_alphas = 4.d0*pi*asf
2340 *
2341  RETURN

◆ hto_as()

real*8 function hto_as ( real*8  R2,
real*8  R20,
real*8  AS0,
integer  NF 
)

Definition at line 2521 of file CALLING_cpHTO.f.

2521  USE hto_aspar
2522  USE hto_betacom
2523 *
2524  IMPLICIT NONE
2525  INTEGER NF,K1
2526  real*8 r2,r20,as0,as1,as2,as3,as4,fbeta1,fbeta2,fbeta3,fbeta4,a,
2527  # lrrat,dlr,xk0,xk1,xk2,xk3,hto_as
2528  INTEGER, parameter :: NFMIN =3
2529  INTEGER, parameter :: NFMAX =6
2530  real*8, parameter :: sxth =0.166666666666666d0
2531 *
2532 * ---------------------------------------------------------------------
2533 *
2534 * ..Input common-blocks
2535 *
2536 *
2537 * ..The beta functions FBETAn at N^nLO for n = 1, 2, and 3
2538 *
2539 *
2540 * ---------------------------------------------------------------------
2541 *
2542 * ..Initial value, evolution distance and step size
2543 *
2544  hto_as = as0
2545  lrrat = log(r2/r20)
2546  dlr = lrrat / nastps
2547 *
2548 * ..Solution of the evolution equation depending on NAORD
2549 * (fourth-order Runge-Kutta beyond the leading order)
2550 *
2551  IF(naord .EQ. 0) THEN
2552 *
2553  hto_as = as0 / (1.+ beta0(nf) * as0 * lrrat)
2554 *
2555  ELSE IF(naord .EQ. 1) THEN
2556 *
2557  DO k1 = 1,nastps
2558  as1= hto_as
2559  fbeta1= - as1**2 * ( beta0(nf) + as1 * beta1(nf) )
2560  xk0 = dlr * fbeta1
2561  as2= hto_as + 0.5d0 * xk0
2562  fbeta2= - as2**2 * ( beta0(nf) + as2 * beta1(nf) )
2563  xk1 = dlr * fbeta2
2564  as3= hto_as + 0.5d0 * xk1
2565  fbeta3= - as3**2 * ( beta0(nf) + as3 * beta1(nf) )
2566  xk2 = dlr * fbeta3
2567  as4= hto_as + xk2
2568  fbeta4= - as4**2 * ( beta0(nf) + as4 * beta1(nf) )
2569  xk3 = dlr * fbeta4
2570  hto_as = hto_as + sxth * (xk0 + 2.d0* xk1 + 2.d0* xk2 + xk3)
2571  ENDDO
2572 *
2573  ELSE IF(naord .EQ. 2) THEN
2574 *
2575  DO k1 = 1,nastps
2576  as1= hto_as
2577  fbeta1= - as1**2 * ( beta0(nf) + as1 * ( beta1(nf)
2578  # + as1 * beta2(nf) ) )
2579  xk0 = dlr * fbeta1
2580  as2= hto_as + 0.5d0 * xk0
2581  fbeta2= - as2**2 * ( beta0(nf) + as2 * ( beta1(nf)
2582  # + as2 * beta2(nf) ) )
2583  xk1 = dlr * fbeta2
2584  as3= hto_as + 0.5d0 * xk1
2585  fbeta3= - as3**2 * ( beta0(nf) + as3 * ( beta1(nf)
2586  # + as3 * beta2(nf) ) )
2587  xk2 = dlr * fbeta3
2588  as4= hto_as + xk2
2589  fbeta4= - as4**2 * ( beta0(nf) + as4 * ( beta1(nf)
2590  # + as4 * beta2(nf) ) )
2591  xk3 = dlr * fbeta4
2592  hto_as = hto_as + sxth * (xk0 + 2.d0* xk1 + 2.d0* xk2 + xk3)
2593  ENDDO
2594 *
2595  ELSE IF(naord .EQ. 3) THEN
2596 *
2597  DO k1 = 1,nastps
2598  as1= hto_as
2599  fbeta1= - as1**2 * ( beta0(nf) + as1 * ( beta1(nf)
2600  # + as1 * (beta2(nf) + as1 * beta3(nf)) ) )
2601  xk0 = dlr * fbeta1
2602  as2= hto_as + 0.5d0 * xk0
2603  fbeta2= - as2**2 * ( beta0(nf) + as2 * ( beta1(nf)
2604  # + as2 * (beta2(nf) + as2 * beta3(nf)) ) )
2605  xk1 = dlr * fbeta2
2606  as3= hto_as + 0.5d0 * xk1
2607  fbeta3= - as3**2 * ( beta0(nf) + as3 * ( beta1(nf)
2608  # + as3 * (beta2(nf) + as3 * beta3(nf)) ) )
2609  xk2 = dlr * fbeta3
2610  as4= hto_as + xk2
2611  fbeta4= - as4**2 * ( beta0(nf) + as4 * ( beta1(nf)
2612  # + as4 * (beta2(nf) + as4 * beta3(nf)) ) )
2613  xk3 = dlr * fbeta4
2614  hto_as = hto_as + sxth * (xk0 + 2.d0* xk1 + 2.d0* xk2 + xk3)
2615  ENDDO
2616 *
2617  ENDIF
2618 *
2619 * ---------------------------------------------------------------------
2620 *
2621  RETURN

◆ hto_asnf1()

real*8 function hto_asnf1 ( real*8  ASNF,
real*8  LOGRH,
integer  NF 
)

Definition at line 2368 of file CALLING_cpHTO.f.

2368  USE hto_aspar
2369  USE hto_rzeta
2370 *
2371  IMPLICIT NONE
2372  INTEGER NF,PRVCLL,K1,K2
2373  real*8 asnf,logrh,cmci30,cmcf30,cmcf31,
2374  # cmci31,asp,lrhp,hto_asnf1
2375  real*8, dimension(3,0:3) :: cmc
2376 **
2377 * ---------------------------------------------------------------------
2378 *
2379 * ..Input common-blocks
2380 *
2381 * ..Variables to be saved for the next call
2382 *
2383  SAVE cmc,cmci30,cmcf30,cmcf31,cmci31,prvcll
2384 *
2385 * ---------------------------------------------------------------------
2386 *
2387 * ..The coupling-constant matching coefficients (CMC's) up to NNNLO
2388 * (calculated and saved in the first call of this routine)
2389 *
2390  IF(prvcll .NE. 1) THEN
2391 *
2392  cmc(1,0) = 0.d0
2393  cmc(1,1) = 2.d0/3.d0
2394 *
2395  cmc(2,0) = 14.d0/3.d0
2396  cmc(2,1) = 38.d0/3.d0
2397  cmc(2,2) = 4.d0/9.d0
2398 *
2399  cmci30 = + 80507.d0/432.d0 * zeta(3) + 58933.d0/1944.d0
2400  # + 128.d0/3.d0 * zeta(2) * (1.+ dlog(2.d0)/3.d0)
2401  cmcf30 = - 64.d0/9.d0 * (zeta(2) + 2479.d0/3456.d0)
2402  cmci31 = 8941.d0/27.d0
2403  cmcf31 = - 409.d0/27.d0
2404  cmc(3,2) = 511.d0/9.d0
2405  cmc(3,3) = 8.d0/27.d0
2406 *
2407  prvcll = 1
2408 *
2409  ENDIF
2410 *
2411 * ---------------------------------------------------------------------
2412 *
2413 * ..The N_f dependent CMC's, and the alpha_s matching at order NAORD
2414 *
2415  cmc(3,0) = cmci30 + nf * cmcf30
2416  cmc(3,1) = cmci31 + nf * cmcf31
2417 *
2418  hto_asnf1 = asnf
2419  IF(naord .EQ. 0) GO TO 1
2420  asp = asnf
2421 *
2422  DO k1 = 1,naord
2423  asp = asp * asnf
2424  lrhp = 1.d0
2425  DO k2 = 0,k1
2426  hto_asnf1 = hto_asnf1 + asp * cmc(k1,k2) * lrhp
2427  lrhp = lrhp * logrh
2428  ENDDO
2429  ENDDO
2430 *
2431  1 RETURN
2432 *

◆ hto_betafct()

subroutine hto_betafct

Definition at line 2644 of file CALLING_cpHTO.f.

2644  USE hto_colour
2645  USE hto_betacom
2646 *
2647  IMPLICIT NONE
2648  INTEGER NF
2649  real*8 b00,b01,b10,b11
2650  INTEGER, parameter :: NFMIN=3
2651  INTEGER, parameter :: NFMAX=6
2652 *
2653 * ---------------------------------------------------------------------
2654 *
2655 * ..the full lo and nlo coefficients
2656 *
2657  b00 = 11.d0/3.d0 * ca
2658  b01 = -4.d0/3.d0 * tr
2659  b10 = 34.d0/3.d0 * ca**2
2660  b11 = -20.d0/3.d0 * ca*tr - 4.* cf*tr
2661 *
2662 * ..flavour-number loop and output to the array
2663 *
2664  DO nf = nfmin,nfmax
2665 *
2666  beta0(nf) = b00 + b01 * nf
2667  beta1(nf) = b10 + b11 * nf
2668 *
2669  beta2(nf) = 1428.50d0 - 279.611d0 * nf + 6.01852d0 * nf**2
2670  beta3(nf) = 29243.0d0 - 6946.30d0 * nf + 405.089d0 * nf**2
2671  # + 1.49931d0 * NF**3
2672  ENDDO
2673 
2674 *
2675  RETURN

◆ hto_cpoles()

subroutine hto_cpoles ( integer  n,
real*8, dimension(n)  xcp,
real*8, dimension(n)  fvcp,
integer  iflag 
)

Definition at line 6768 of file CALLING_cpHTO.f.

6768  USE hto_ferbos
6769  USE hto_aux_hcp
6770  USE hto_units
6771  USE hto_acmplx_pro
6772  USE hto_acmplx_rat
6773  USE hto_full_ln
6774  USE hto_ln_2_riemann
6775  USE hto_masses
6776  USE hto_set_phys_const
6777  USE hto_riemann
6778  USE hto_optcp
6779  USE hto_transfmh
6780  USE hto_qcd
6781 *
6782  IMPLICIT NONE
6783 *
6784  INTEGER nc,n,iflag,iz
6785  real*8 muh,rgh,muhs,scal,scals,p2,xm0,str,sti,rgw,
6786  # lswr,lswi,lmw,bxm0,emc,emb,emt,asmur,rgt,as_NLO,EWC,
6787  # crmbs,crmcs,lcxb,lcxc,lcxbs,lcxcs,lclxb,lclxc,as_LO
6788  real*8, dimension(n) :: xcp,fvcp
6789  real*8, dimension(2,2) :: axms
6790  real*8, dimension(2) :: axm0,bxms,runbc
6791  real*8, dimension(2) :: sh,shs,clh,b0sumb,b0sumf,cxp,ksumb,
6792  # ksumf,coefB1,coefB2,coefB3,coefB4,coefB5,coefB6,coefB7,
6793  # coefB8,coefB9,coefB10,coefB11,coefB12,
6794  # shhf,shht,shhb,shh,b0sumt,ksumt,xms,
6795  # b0part,cpt,cpts,ccxt,deltag,sww0,coefW1,
6796  # coefW2,ksumw,ccxts,cctsi,shi,clt,cxhw,cstsi,csmcts,cltmw,
6797  # b0sumw,sww,DW,b0sumw1,b0sumw2,cxw,cxz,ccts,clw,csts,
6798  # cctq,cxws,cmxw,clmw,cxtw,kfmsb,ktmsb,kbmsb,kwmsb,
6799  # coeft1,coeft2,coeft3,coeft4,b0sumtop,ksumtop,stt,
6800  # coeft1s,b0sumtops,ksumtops,stts,cctqi,ucpt,nloqcd,ttqcd,
6801  # DWW,sww0W,swwW,ksumwW,lcxwi,lclcts
6802 *
6803  INTERFACE
6804  SUBROUTINE hto_initalphas(asord,FR2,MUR,asmur,emc,emb,emt)
6805  USE hto_dzpar
6806  IMPLICIT NONE
6807  INTEGER asord
6808  real*8 fr2,mur,asmur,emc,emb,emt,hto_findalphasr0
6809  EXTERNAL hto_findalphasr0
6810  END SUBROUTINE hto_initalphas
6811  END INTERFACE
6812 *
6813  INTERFACE
6814  FUNCTION hto_alphas(MUR)
6815  USE hto_nffix
6816  USE hto_varflv
6817  USE hto_frrat
6818  USE hto_asinp
6819  USE hto_asfthr
6820  IMPLICIT NONE
6821  real*8 mur,hto_alphas
6822  END FUNCTION hto_alphas
6823  END INTERFACE
6824 *
6825  INTERFACE
6826  FUNCTION hto_lquarkqcd(scal,psi,ps0i,xmsi,xm0i,type)
6827  # RESULT(value)
6828  USE hto_riemann
6829  USE hto_acmplx_pro
6830  USE hto_acmplx_rat
6831  USE hto_cmplx_root
6832  USE hto_cmplx_rootz
6833  USE hto_cmplx_srs_root
6834  USE hto_ln_2_riemann
6835  USE hto_full_ln
6836  USE hto_sp_fun
6837  USE hto_units
6838  IMPLICIT NONE
6839  INTEGER type
6840  real*8 scal,ps0i,xm0i
6841  real*8, dimension(2) :: value,psi,xmsi
6842  END FUNCTION hto_lquarkqcd
6843  END INTERFACE
6844 *
6845  INTERFACE
6846  FUNCTION hto_lb0af_em(scal,psi,ps0i,xmsi,xm0i) RESULT(value)
6847  USE hto_acmplx_pro
6848  USE hto_acmplx_rat
6849  USE hto_cmplx_root
6850  USE hto_cmplx_rootz
6851  USE hto_cmplx_srs_root
6852  USE hto_ln_2_riemann
6853  USE hto_full_ln
6854  USE hto_units
6855  IMPLICIT NONE
6856  real*8 scal,ps0i,xm0i
6857  real*8, dimension(2) :: value,psi,xmsi
6858  END FUNCTION hto_lb0af_em
6859  END INTERFACE
6860 *
6861  INTERFACE
6862  FUNCTION hto_lb0af_dm(scal,psi,ps0i,xmsi,xm0i) RESULT(value)
6863  USE hto_acmplx_pro
6864  USE hto_acmplx_rat
6865  USE hto_cmplx_root
6866  USE hto_cmplx_rootz
6867  USE hto_cmplx_srs_root
6868  USE hto_ln_2_riemann
6869  USE hto_full_ln
6870  USE hto_units
6871  IMPLICIT NONE
6872  real*8 scal,ps0i
6873  real*8, dimension(2,2) :: xmsi
6874  real*8, dimension(2) :: value,psi,xm0i
6875  END FUNCTION hto_lb0af_dm
6876  END INTERFACE
6877 *
6878  INTERFACE
6879  FUNCTION hto_lb021_dm_cp(scal,psi,ps0i,xmsi,xm0i) RESULT(value)
6880  USE hto_cmplx_root
6881  USE hto_cmplx_rootz
6882  USE hto_cmplx_srs_root
6883  USE hto_ln_2_riemann
6884  USE hto_acmplx_pro
6885  USE hto_acmplx_rat
6886  USE hto_full_ln
6887  USE hto_units
6888  IMPLICIT NONE
6889  real*8 scal,ps0i
6890  real*8, intent(in), dimension(2) :: xm0i
6891  real*8, intent(in), dimension(2,2) :: xmsi
6892  real*8, dimension(2) :: value
6893  real*8, dimension(2) :: psi
6894  END FUNCTION hto_lb021_dm_cp
6895  END INTERFACE
6896 *
6897  muh= tmuh
6898  scal= muh
6899  muhs= muh*muh
6900  scals= scal*scal
6901 *
6902  cxw(1)= mw*mw/scals*(1.d0-0.5d-2*(xcp(1)*xcp(1))**2)
6903  cxw(2)= -1.d-1*mw*mw/scals*xcp(1)*xcp(1)
6904 *
6905  cmxw= -cxw
6906  cxws= cxw.cp.cxw
6907  lcxwi= co.cq.cxw
6908 *
6909  rgw= 1.d-1*xcp(1)*xcp(1)*mw
6910  rgh= 1.d-2*xcp(2)*xcp(2)*muh
6911  IF(n == 3) THEN
6912  rgt= 1.d-2*xcp(3)*xcp(3)*mt
6913  ELSEIF(n == 2) THEN
6914  rgt= imt
6915  ENDIF
6916 *
6917  lswr= mw*mw*(1.d0-0.5d-2*(xcp(1)*xcp(1))**2)
6918  lswi= -mw*rgw
6919 *
6920  clw= cxw(1).fln.cxw(2)
6921  clmw= cmxw(1).fln.cmxw(2)
6922  clmw(2)= clmw(2)-2.d0*pi
6923 *
6924  cxz(1)= szr/scals
6925  cxz(2)= szi/scals
6926  ccts= cxw.cq.cxz
6927  csts= co-ccts
6928  cctq= ccts.cp.ccts
6929  cctqi= co.cq.cctq
6930  lclcts= ccts(1).fln.ccts(2)
6931 *
6932  asmur= 0.12018d0
6933  emc= 1.4d0
6934  emb= 4.75d0
6935  emt= mt
6936  iz= 1
6937  CALL hto_initalphas(iz,one,mz,asmur,emc,emb,emt)
6938  as_nlo= hto_alphas(scal)/pi
6939  runbc= hto_run_bc(scal)
6940  crmbs= runbc(2)*runbc(2)
6941  crmcs= runbc(1)*runbc(1)
6942 *
6943  lcxb= crmbs/scals
6944  lcxc= crmcs/scals
6945 *
6946  lcxbs= lcxb*lcxb
6947  lcxcs= lcxc*lcxc
6948  lclxb= log(lcxb)
6949  lclxc= log(lcxc)
6950 *
6951  ucpt(1)= mt*mt
6952  ucpt(2)= 0.d0
6953  cpt(1)= mt*mt/scals
6954  cpt(2)= 0.d0
6955  cpts= cpt.cp.cpt
6956 *
6957  ccxt= cpt
6958  ccxts= ccxt.cp.ccxt
6959  cctsi= co.cq.ccts
6960  cstsi= co.cq.csts
6961  csmcts= csts-ccts
6962 *
6963  sh(1)= muhs/scals
6964  sh(2)= -muh*rgh/scals
6965 *
6966  cxhw= sh-cxw
6967  shs= sh.cp.sh
6968  shi= co.cq.sh
6969 *
6970  cxtw= ccxt-cxw
6971  clh= sh(1).fln.sh(2)
6972  clt= ccxt(1).fln.ccxt(2)
6973  cltmw= cxtw(1).fln.cxtw(2)
6974 *
6975 * w
6976  coefb1= (12.d0*cxw-4.d0*sh+(shs.cq.cxw))/64.d0
6977 *
6978 * z
6979  coefb2= (-4.d0*(sh.cq.ccts)+(shs.cq.cxw)+
6980  # 12.d0*(cxw.cq.cctq))/128.d0
6981 *
6982 * h
6983  coefb3= 9.d0/128.d0*(shs.cq.cxw)
6984 *
6985 * top
6986  coefb4= -3.d0/32.d0*((4.d0*ccxt-sh).cp.(ccxt.cq.cxw))
6987 *
6988 * light fermions
6989 *
6990  coefb5= -3.d0/32.d0*((4.d0*co*lcxb-sh).cq.cxw)*lcxb
6991 *
6992  coefb6= -1.d0/32.d0*((4.d0*co*cxtau-sh).cq.cxw)*cxtau
6993 *
6994  coefb7= -3.d0/32.d0*((4.d0*co*lcxc-sh).cq.cxw)*lcxc
6995 *
6996  coefb8= -1.d0/32.d0*((4.d0*co*cxmu-sh).cq.cxw)*cxmu
6997 *
6998  coefb9= -3.d0/32.d0*((4.d0*co*cxs-sh).cq.cxw)*cxs
6999 *
7000  coefb10= -3.d0/32.d0*((4.d0*co*cxd-sh).cq.cxw)*cxd
7001 *
7002  coefb11= -3.d0/32.d0*((4.d0*co*cxu-sh).cq.cxw)*cxu
7003 *
7004  coefb12= -1.d0/32.d0*((4.d0*co*cxe-sh).cq.cxw)*cxe
7005 *
7006  cxp(1)= muhs
7007  cxp(2)= -muh*rgh
7008  p2= muhs
7009 *
7010  xms(1)= lswr
7011  xms(2)= lswi
7012  xm0= mw
7013  b0part= hto_lb0af_em(scal,cxp,p2,xms,xm0)
7014  b0sumb= coefb1.cp.b0part
7015 *
7016  xms(1)= szr
7017  xms(2)= szi
7018  xm0= mz
7019  b0part= hto_lb0af_em(scal,cxp,p2,xms,xm0)
7020  b0sumb= b0sumb+(coefb2.cp.b0part)
7021 *
7022  xms(1)= muhs
7023  xms(2)= -muh*rgh
7024  xm0= muh
7025  b0part= hto_lb0af_em(scal,cxp,p2,xms,xm0)
7026  b0sumb= b0sumb+(coefb3.cp.b0part)
7027 *
7028  xms(1:2)= crmbs*co(1:2)
7029  xm0= sqrt(crmbs)
7030  b0part= hto_lb0af_em(scal,cxp,p2,xms,xm0)
7031  b0sumf= coefb5.cp.b0part
7032 *
7033  xms(1:2)= mtl*mtl*co(1:2)
7034  xm0= mtl
7035  b0part= hto_lb0af_em(scal,cxp,p2,xms,xm0)
7036  b0sumf= b0sumf+(coefb6.cp.b0part)
7037 *
7038  xms(1:2)= crmcs*co(1:2)
7039  xm0= sqrt(crmcs)
7040  b0part= hto_lb0af_em(scal,cxp,p2,xms,xm0)
7041  b0sumf= b0sumf+(coefb7.cp.b0part)
7042 *
7043  xms(1:2)= mm*mm*co(1:2)
7044  xm0= mm
7045  b0part= hto_lb0af_em(scal,cxp,p2,xms,xm0)
7046  b0sumf= b0sumf+(coefb8.cp.b0part)
7047 *
7048  xms(1:2)= msq*msq*co(1:2)
7049  xm0= msq
7050  b0part= hto_lb0af_em(scal,cxp,p2,xms,xm0)
7051  b0sumf= b0sumf+(coefb9.cp.b0part)
7052 *
7053  xms(1:2)= mdq*mdq*co(1:2)
7054  xm0= mdq
7055  b0part= hto_lb0af_em(scal,cxp,p2,xms,xm0)
7056  b0sumf= b0sumf+(coefb10.cp.b0part)
7057 *
7058  xms(1:2)= muq*muq*co(1:2)
7059  xm0= muq
7060  b0part=hto_lb0af_em(scal,cxp,p2,xms,xm0)
7061  b0sumf= b0sumf+(coefb11.cp.b0part)
7062 *
7063  xms(1:2)= me*me*co(1:2)
7064  xm0= me
7065  b0part= hto_lb0af_em(scal,cxp,p2,xms,xm0)
7066  b0sumf= b0sumf+(coefb12.cp.b0part)
7067 *
7068  xms(1:2)= ucpt(1:2)
7069  xm0= mt
7070  b0part= hto_lb0af_em(scal,cxp,p2,xms,xm0)
7071  b0sumt= coefb4.cp.b0part
7072 *
7073  iz= 0
7074  xms(1:2)= crmbs*co(1:2)
7075  xm0= sqrt(crmbs)
7076  nloqcd= crmbs*hto_lquarkqcd(scal,cxp,p2,xms,xm0,iz)
7077  xms(1:2)= crmcs*co(1:2)
7078  xm0= sqrt(crmcs)
7079  nloqcd= nloqcd+crmcs*hto_lquarkqcd(scal,cxp,p2,xms,xm0,iz)
7080  IF(qcdc==0) nloqcd= 0.d0
7081 *
7082  xms= ucpt
7083  xm0= mt
7084  iz= 1
7085  ttqcd= hto_lquarkqcd(scal,cxp,p2,xms,xm0,iz)
7086  ttqcd= cpt.cp.ttqcd
7087  IF(qcdc==0) ttqcd= 0.d0
7088 *
7089  ksumf= -1.d0/32.d0*(sh.cq.cxw)*(cxe*clxe+cxmu*clxmu+
7090  # cxtau*clxtau+3.d0*(cxd*clxd+cxs*clxs+lcxb*lclxb+
7091  # cxu*clxu+lcxc*lclxc))+
7092  # 1.d0/8.d0*lcxwi*(cxes+cxmus+cxtaus+3.d0*(
7093  # cxds+cxss+lcxbs+cxus+lcxcs))
7094  ksumt= 3.d0/8.d0*((ccxt.cq.cxw).cp.ccxt)
7095  # -3.d0/32.d0*(clt.cp.((sh.cq.cxw).cp.ccxt))
7096 *
7097  ksumb= -1.d0/64.d0*((2.d0*co+cctsi+3.d0*(sh.cq.cxw)).cp.sh)
7098  # -1.d0/128.d0*(lclcts.cp.((6.d0*cctsi-(sh.cq.cxw)).cp.sh))
7099  # +3.d0/128.d0*(clw.cp.((4.d0*co+2.d0*cctsi-(sh.cq.cxw)).cp.sh))
7100  # -3.d0/128.d0*(clh.cp.(shs.cq.cxw))
7101 *
7102  shhf= b0sumf+ksumf
7103  shht= b0sumt+ksumt
7104  IF((lswr*shht(2)+lswi*shht(1)) < 0.d0) shht= 0.d0
7105  shhf= shhf+shht
7106  shhb= b0sumb+ksumb
7107  IF((lswr*shhb(2)+lswi*shhb(1)) < 0.d0) shhb= 0.d0
7108  shh= shhf+shhb
7109 *
7110 *--- w self energies
7111 *
7112  deltag= 6.d0*co+0.5d0*(((7.d0*co-4.d0*csts).cq.csts).cp.lclcts)
7113 *
7114  sww0= -(38.d0*cxw+6.d0*ccxt+7.d0*sh
7115  # -48.d0*(((ccxt.cq.sh).cq.cxw).cp.ccxt)+8.d0*(cxw.cq.sh))/128.d0
7116  # -3.d0/64.d0*((cxw-sh+(cxws.cq.cxhw)).cp.clh)
7117  # +3.d0/32.d0*(((co-4.d0*((ccxt.cq.sh).cq.cxw).cp.ccxt)).cp.clt)
7118  # +((((8.d0*co-17.d0*cstsi+3.d0*cctsi).cp.cxw)
7119  # -6.d0*((cxw.cq.sh).cq.cctq)).cp.lclcts)/64.d0
7120  # -((cxw.cq.sh).cq.cctq)/32.d0+5.d0/128.d0*(cxw.cq.ccts)
7121 *
7122  sww0w= -(38.d0*cxw+6.d0*ccxt+7.d0*sh
7123  # -48.d0*(((ccxt.cq.sh).cq.cxw).cp.ccxt)+8.d0*(cxw.cq.sh))/128.d0
7124  # -3.d0/64.d0*((cxw-sh+(cxws.cq.cxhw)).cp.(clh-clw))
7125  # +3.d0/32.d0*
7126  # (((co-4.d0*((ccxt.cq.sh).cq.cxw).cp.ccxt)).cp.(clt-clw))
7127  # +((((8.d0*co-17.d0*cstsi+3.d0*cctsi).cp.cxw)
7128  # -6.d0*((cxw.cq.sh).cq.cctq)).cp.lclcts)/64.d0
7129  # -((cxw.cq.sh).cq.cctq)/32.d0+5.d0/128.d0*(cxw.cq.ccts)
7130 *
7131  coefw1= -(((8.d0*co-(sh.cq.cxw)).cp.sh)*sh
7132  # -4.d0*((-12.d0*cxw+7.d0*sh).cp.cxw))/192.d0
7133 *
7134  coefw2= -((cxws.cq.csmcts).cp.(416.d0*co-192.d0*csts
7135  # -((132.d0*co-((12.d0*co+cctsi).cq.ccts)).cq.ccts)))/192.d0
7136 *
7137  cxp(1)= lswr
7138  cxp(2)= lswi
7139  p2= mw*mw
7140 *
7141  axms(1,1)= lswr
7142  axms(1,2)= lswi
7143  axm0(1)= mw
7144  axms(2,1)= muhs
7145  axms(2,2)= -muh*rgh
7146  axm0(2)= muh
7147  b0part= hto_lb021_dm_cp(scal,cxp,p2,axms,axm0)
7148  b0sumw1= (coefw1.cp.b0part)
7149  b0sumw= (coefw1.cp.b0part)
7150 *
7151  axms(1,1)= szr
7152  axms(1,2)= szi
7153  axm0(1)= mz
7154  axms(2,1)= lswr
7155  axms(2,2)= lswi
7156  axm0(2)= mw
7157  b0part= hto_lb021_dm_cp(scal,cxp,p2,axms,axm0)
7158  b0sumw2= (coefw2.cp.b0part)
7159  b0sumw= b0sumw+(coefw2.cp.b0part)
7160 *
7161  ksumw= -12.d0*((cxw
7162  # -0.5d0*((3.d0*co-(ccxts.cq.cxws)).cp.ccxt)).cp.cltmw)
7163  # -((24.d0*cxw-((14.d0*co-(sh.cq.cxw)).cp.sh)).cp.clh)
7164  # +((36.d0*cxw-14.d0*sh-18.d0*((co-4.d0*(ccxt.cq.sh)).cp.ccxt)
7165  # +(shs.cq.cxw)).cp.clw)
7166  # -6.d0*(((2.d0*co+((lcxwi-12.d0*shi).cp.ccxt)).cp.ccxt)
7167  # +1.d0/6.d0*((15.d0*co-(sh.cq.cxw)).cp.sh)
7168  # +2.d0/9.d0*((97.d0*co+9.d0*(cxw.cq.sh)).cp.cxw))
7169  # +(((cxw.cq.ccts).cp.(co-6.d0*(cxw.cq.sh))).cq.ccts)
7170  # -2.d0*(((cxw.cq.csmcts).cp.lclcts).cp.(62.d0*co
7171  # -48.d0*csts-5.d0*cctsi))
7172  # -18.d0*(((cxws.cq.sh).cq.cctq).cp.lclcts)
7173  # -72.d0*((clt.cp.ccxts).cp.(shi-1.d0/12.d0*(ccxt.cq.cxws)))
7174  # +23.d0*(cxw.cq.ccts)
7175  ksumw= ksumw/192.d0+3.d0/16.d0*(cxw.cp.(clw-clmw))
7176 *
7177  ksumww= -12.d0*((cxw
7178  # -0.5d0*((3.d0*co-(ccxts.cq.cxws)).cp.ccxt)).cp.(cltmw-clw))
7179  # -((24.d0*cxw-((14.d0*co-(sh.cq.cxw)).cp.sh)).cp.(clh-clw))
7180  # -6.d0*(((2.d0*co+((lcxwi-12.d0*shi).cp.ccxt)).cp.ccxt)
7181  # +1.d0/6.d0*((15.d0*co-(sh.cq.cxw)).cp.sh)
7182  # +2.d0/9.d0*((97.d0*co+9.d0*(cxw.cq.sh)).cp.cxw))
7183  # +(((cxw.cq.ccts).cp.(co-6.d0*(cxw.cq.sh))).cq.ccts)
7184  # -2.d0*(((cxw.cq.csmcts).cp.lclcts).cp.(62.d0*co
7185  # -48.d0*csts-5.d0*cctsi))
7186  # -18.d0*(((cxws.cq.sh).cq.cctq).cp.lclcts)
7187  # -72.d0*
7188  # (((clt-clw).cp.ccxts).cp.(shi-1.d0/12.d0*(ccxt.cq.cxws)))
7189  # +23.d0*(cxw.cq.ccts)
7190  ksumww= ksumww/192.d0+3.d0/16.d0*(cxw.cp.(clw-clmw))
7191 *
7192  sww= b0sumw+ksumw
7193  swww= b0sumw+ksumww
7194 *
7195  dw= -sww+sww0+deltag/16.d0
7196  dww= -swww+sww0w+deltag/16.d0
7197 * dw= 0.d0
7198 *
7199  ksumtop= 1.d0/128.d0*(-(2.d0*cxw+3.d0*cxb*co+cxbs*lcxwi)+48.d0*
7200  # ((cpt.cq.sh).cq.cxw)*cxbs+(cpts.cq.cxw)+(cpt.cp.(co
7201  # -4.d0*cxb*lcxwi)))*clxb
7202  # +1.d0/576.d0*(-(50.d0*cxw-9.d0*cxb*co-9.d0*cxbs*lcxwi
7203  # +17.d0*(cxw.cq.cctq)-40.d0*(cxw.cq.ccts))+18.d0*(cpts.cq.cxw)
7204  # +(cpt.cp.(co+17.d0*cctsi+9.d0*cxb*lcxwi-216.d0*((
7205  # cpts.cq.cxw).cq.sh)+54.d0*((cxw.cq.sh).cq.cctq)
7206  # +18.d0*(sh.cq.cxw)-216.d0*(shi.cp.cxw)*cxbs+108.d0*(cxw.cq.sh))))
7207  # +1.d0/1152.d0*(clt.cp.(432.d0*((cpts.cq.cxw).cp.(cpt.cq.sh))
7208  # -(cxw.cp.(32.d0*co-40.d0*cctsi+17.d0*cctqi))
7209  # +(cpt.cp.(32.d0-64.d0*csts-41.d0*cctsi-9.d0*(sh.cq.cxw)))))
7210  # -1.d0/128.d0*(clh.cp.((-4.d0*cpt+5.d0*sh).cp.(cpt.cq.cxw)))
7211  # +1.d0/1152.d0*(clw.cp.((50.d0*cxw+27.d0*cxb*co+9.d0*cxbs*
7212  # lcxwi+17.d0*(cxw.cq.cctq)-40.d0*(cxw.cq.ccts))
7213  # +9.d0*(cpts.cq.cxw)+(cpt.cp.(7.d0*co+64.d0*csts-7.d0*cctsi
7214  # -18.d0*cxb*lcxwi-108.d0*((cxw.cq.sh).cq.cctq)
7215  # -216.d0*(cxw.cq.sh)))))
7216  # -1.d0/1152.d0*(lclcts.cp.((cxw.cp.(32.d0*co-40.d0*
7217  # cctsi+17.d0*cctqi))+(cpt.cp.(16.d0*co+64.d0*csts-7.d0*
7218  # cctsi-108.d0*((cxw.cq.sh).cq.cctq)))))
7219 *
7220  coeft1= -1.d0/576.d0*(-(cxw.cp.(32.d0*co-40.d0*cctsi+17.d0*
7221  # cctqi))+(cpt.cp.(16.d0*co+64.d0*csts-7.d0*cctsi)))
7222 *
7223  coeft2= 1.d0/64.d0*((-4.d0*cpt+sh).cp.(cpt.cq.cxw))
7224 *
7225  coeft3= 1.d0/9.d0*(csts.cp.cpt)
7226 *
7227  coeft4= 1.d0/64.d0*((-2.d0*cxw+cxb*co+cxbs*lcxwi)
7228  # +(cpts.cq.cxw)+(cpt.cp.(co-2.d0*cxb*lcxwi)))
7229 *
7230  cxp(1)= mt*mt
7231  cxp(2)= -mt*rgt
7232  p2= mt*mt
7233 *
7234  axms(1,1)= mt*mt
7235  axms(1,2)= -mt*rgt
7236  axm0(1)= mt
7237  axms(2,1)= szr
7238  axms(2,2)= szi
7239  axm0(2)= mz
7240  b0part= hto_lb0af_dm(scal,cxp,p2,axms,axm0)
7241  b0sumtop= (coeft1.cp.b0part)
7242 *
7243  axms(1,1)= mt*mt
7244  axms(1,2)= -mt*rgt
7245  axm0(1)= mt
7246  axms(2,1)= muhs
7247  axms(2,2)= -muh*rgh
7248  axm0(2)= muh
7249  b0part= hto_lb0af_dm(scal,cxp,p2,axms,axm0)
7250  b0sumtop= b0sumtop+(coeft2.cp.b0part)
7251 *
7252  b0part= 2.d0*co
7253  b0sumtop= b0sumtop+(coeft3.cp.b0part)
7254 *
7255  axms(1,1)= mb*mb
7256  axms(1,2)= 0.d0
7257  axm0(1)= mb
7258  axms(2,1)= lswr
7259  axms(2,2)= lswi
7260  axm0(2)= mw
7261  b0part= hto_lb0af_dm(scal,cxp,p2,axms,axm0)
7262  b0sumtop= b0sumtop+(coeft4.cp.b0part)
7263 *
7264  ksumtops= cpt/6.d0-(clt.cp.cpt)/2.d0
7265 *
7266  coeft1s= 1.d0/3.d0*cpt
7267 *
7268  b0part= 2.d0*co
7269  b0sumtops= coeft1s.cp.b0part
7270 *
7271  stt= b0sumtop+ksumtop
7272  stts= b0sumtops+ksumtops
7273 *
7274  ewc= 4.d0*sqrt(2.d0)*g_f/pis
7275 *
7276  asmur= 0.13939d0
7277  emc= 1.4d0
7278  emb= 4.75d0
7279  emt= mt
7280  iz= 0
7281  CALL hto_initalphas(iz,one,mz,asmur,emc,emb,emt)
7282  as_lo= hto_alphas(scal)/pi
7283 *
7284  fvcp(1)= rgw/mw*(1.d0+ewc*(lswr*dww(1)-lswi*dww(2)))
7285  # -EWC*(scal/mw)**2*(lswr*swwW(2)+lswi*swwW(1))
7286 *
7287  fvcp(2)= rgh/muh*(1.d0+ewc*(lswr*dw(1)-lswi*dw(2)))
7288  # -EWC*(lswr*shh(2)+lswi*shh(1))*scals/muhs
7289  # +as_NLO*g_f/(sqrt(2.d0)*pis)*
7290  # (sh(1)*nloqcd(2)+sh(2)*nloqcd(1))*scals/muhs
7291  # +as_NLO*g_f/(sqrt(2.d0)*pis)*
7292  # (sh(1)*ttqcd(2)+sh(2)*ttqcd(1))*scals/muhs
7293 *
7294  IF(n == 3) THEN
7295  fvcp(3)= rgt/mt*(1.d0+2.d0*ewc*(lswr*dw(1)-lswi*dw(2)))
7296  # -scals/(mt*mt)*(EWC*(lswr*stt(2)+lswi*stt(1))+
7297  # 4.d0*(scals/(mt*mt))*as_LO*stts(2))
7298  ENDIF
7299 *
7300  RETURN
7301 *

◆ hto_deriv()

real*8 function, dimension(10,2) hto_deriv ( real*8  scal,
real*8  rhm 
)

Definition at line 4545 of file CALLING_cpHTO.f.

4545  USE hto_masses
4546  USE hto_acmplx_pro
4547  USE hto_acmplx_rat
4548  USE hto_cmplx_root
4549  USE hto_full_ln
4550  USE hto_qcd
4551  USE hto_set_phys_const
4552  USE hto_units
4553 *
4554  IMPLICIT NONE
4555 *
4556  INTEGER iz
4557  real*8 scal,scals,rhm,ps,xw,xz,lw,lz,ls,xe,lxe,xmu,lxmu,xtau,
4558  # lxtau,xu,lxu,xd,lxd,xc,lxc,xs,lxs,xt,lxt,xb,lxb,rmbs,rmcs,
4559  # xes,xmus,xtaus,xus,xds,xcs,xss,xts,xbs,
4560  # xec,xmuc,xtauc,xuc,xdc,xcc,xsc,xtc,xbc,
4561  # bwis,bzis,fw,fz,
4562  # bxeis,bxmuis,bxtauis,bxuis,bxdis,bxcis,bxsis,bxtis,bxbis,
4563  # bxes,bxmus,bxtaus,bxus,bxds,bxcs,bxss,bxts,bxbs,
4564  # asmur,emc,emb,emt
4565  real*8, dimension(2) :: bs,bw,bz,arg,lbw,lbz,dmz,bzi,bh,lbh,bwi,
4566  # dmw,dmh,sh,bxe,lbxe,bxmu,lbxmu,bxtau,lbxtau,bxu,lbxu,bxd,
4567  # lbxd,bxc,lbxc,bxs,lbxs,bxt,lbxt,bxb,lbxb,runbc,bwic,bzic,
4568  # d2mh,dmwh,dmzh,dmzw,dmww,dmzz,
4569  # bxei,bxmui,bxtaui,bxui,bxdi,bxci,bxsi,bxti,bxbi
4570  real*8, dimension(10,2) :: value
4571 *
4572  INTERFACE
4573  SUBROUTINE hto_initalphas(asord,FR2,MUR,asmur,emc,emb,emt)
4574  USE hto_dzpar
4575  IMPLICIT NONE
4576  INTEGER asord
4577  real*8 fr2,mur,asmur,emc,emb,emt,hto_findalphasr0
4578  EXTERNAL hto_findalphasr0
4579  END SUBROUTINE hto_initalphas
4580  END INTERFACE
4581 *
4582  INTERFACE
4583  FUNCTION hto_alphas(MUR)
4584  USE hto_nffix
4585  USE hto_varflv
4586  USE hto_frrat
4587  USE hto_asinp
4588  USE hto_asfthr
4589  IMPLICIT NONE
4590  real*8 mur,hto_alphas
4591  END FUNCTION hto_alphas
4592  END INTERFACE
4593 *
4594  scals= scal*scal
4595  ps= rhm*rhm
4596 *
4597  xw= (mw*mw)/ps
4598  xz= (mz*mz)/ps
4599  lw= log(xw)
4600  lz= log(xz)
4601  ls= log(ps/scals)
4602  fw= 1.d0-4.d0*xw*(1.d0-3.d0*xw)
4603  fz= 1.d0-4.d0*xz*(1.d0-3.d0*xz)
4604 *
4605  asmur= 0.12018d0
4606  emc= 1.4d0
4607  emb= 4.75d0
4608  emt= mt
4609  iz= 1
4610  CALL hto_initalphas(iz,one,mz,asmur,emc,emb,emt)
4611  als= hto_alphas(scal)
4612  runbc= hto_run_bc(scal)
4613  rmbs= runbc(2)*runbc(2)
4614  rmcs= runbc(1)*runbc(1)
4615 *
4616  xe= (me*me)/ps
4617  lxe= log(xe)
4618  xmu= (mm*mm)/ps
4619  lxmu= log(xmu)
4620  xtau= (mtl*mtl)/ps
4621  lxtau= log(xtau)
4622  xu= (muq*muq)/ps
4623  lxu= log(xu)
4624  xd= (mdq*mdq)/ps
4625  lxd= log(xd)
4626  xc= rmcs/ps
4627  lxc= log(xc)
4628  xs= (msq*msq)/ps
4629  lxs= log(xs)
4630  xt= (mt*mt)/ps
4631  lxt= log(xt)
4632  xb= rmbs/ps
4633  lxb= log(xb)
4634  xes= xe*xe
4635  xmus= xmu*xmu
4636  xtaus= xtau*xtau
4637  xus= xu*xu
4638  xds= xd*xd
4639  xcs= xc*xc
4640  xss= xs*xs
4641  xts= xt*xt
4642  xbs= xb*xb
4643  xec= xes*xe
4644  xmuc= xmus*xmu
4645  xtauc= xtaus*xtau
4646  xuc= xus*xu
4647  xdc= xds*xd
4648  xcc= xcs*xc
4649  xsc= xss*xs
4650  xtc= xts*xt
4651  xbc= xbs*xb
4652 *
4653 * H
4654 *
4655  bs(1)= -3.d0
4656  bs(2)= -eps
4657  bh= (bs(1)).cr.(bs(2))
4658  arg= (bh+co).cq.(bh-co)
4659  IF(arg(2).eq.0.d0) arg(2)= eps
4660  lbh= arg(1).fln.arg(2)
4661 *
4662 *
4663 * W
4664 *
4665  bs(1)= 1.d0-4.d0*(mw*mw)/ps
4666  bs(2)= -eps
4667  bw= (bs(1)).cr.(bs(2))
4668  IF(bw(2).eq.0.d0) bw(2)= -eps
4669  bwi= co.cq.bw
4670  IF(bwi(2).eq.0.d0) bwi(2)= eps
4671  bwis= 1.d0/(1.d0-4.d0*(mw*mw)/ps)
4672  bwic= bwis*bwi
4673  arg= (bw+co).cq.(bw-co)
4674  IF(arg(2).eq.0.d0) arg(2)= eps
4675  lbw= arg(1).fln.arg(2)
4676 *
4677 * Z
4678 *
4679  bs(1)= 1.d0-4.d0*(mz*mz)/ps
4680  bs(2)= -eps
4681  bz= (bs(1)).cr.(bs(2))
4682  IF(bz(2).eq.0.d0) bz(2)= -eps
4683  bzi= co.cq.bz
4684  IF(bzi(2).eq.0.d0) bzi(2)= eps
4685  bzis= 1.d0/(1.d0-4.d0*(mz*mz)/ps)
4686  bzic= bzis*bzi
4687  arg= (bz+co).cq.(bz-co)
4688  IF(arg(2).eq.0.d0) arg(2)= eps
4689  lbz= arg(1).fln.arg(2)
4690 *
4691 * f
4692 *
4693  bs(1)= 1.d0-4.d0*(me*me)/ps
4694  bs(2)= -eps
4695  bxe= (bs(1)).cr.(bs(2))
4696  arg= (bxe+co).cq.(bxe-co)
4697  IF(arg(2).eq.0.d0) arg(2)= eps
4698  lbxe= arg(1).fln.arg(2)
4699 *
4700  bs(1)= 1.d0-4.d0*(mm*mm)/ps
4701  bs(2)= -eps
4702  bxmu= (bs(1)).cr.(bs(2))
4703  arg= (bxmu+co).cq.(bxmu-co)
4704  IF(arg(2).eq.0.d0) arg(2)= eps
4705  lbxmu= arg(1).fln.arg(2)
4706 *
4707  bs(1)= 1.d0-4.d0*(mtl*mtl)/ps
4708  bs(2)= -eps
4709  bxtau= (bs(1)).cr.(bs(2))
4710  arg= (bxtau+co).cq.(bxtau-co)
4711  IF(arg(2).eq.0.d0) arg(2)= eps
4712  lbxtau= arg(1).fln.arg(2)
4713 *
4714  bs(1)= 1.d0-4.d0*(muq*muq)/ps
4715  bs(2)= -eps
4716  bxu= (bs(1)).cr.(bs(2))
4717  arg= (bxu+co).cq.(bxu-co)
4718  IF(arg(2).eq.0.d0) arg(2)= eps
4719  lbxu= arg(1).fln.arg(2)
4720 *
4721  bs(1)= 1.d0-4.d0*(mdq*mdq)/ps
4722  bs(2)= -eps
4723  bxd= (bs(1)).cr.(bs(2))
4724  arg= (bxd+co).cq.(bxd-co)
4725  IF(arg(2).eq.0.d0) arg(2)= eps
4726  lbxd= arg(1).fln.arg(2)
4727 *
4728  bs(1)= 1.d0-4.d0*rmcs/ps
4729  bs(2)= -eps
4730  bxc= (bs(1)).cr.(bs(2))
4731  arg= (bxc+co).cq.(bxc-co)
4732  IF(arg(2).eq.0.d0) arg(2)= eps
4733  lbxc= arg(1).fln.arg(2)
4734 *
4735  bs(1)= 1.d0-4.d0*(msq*msq)/ps
4736  bs(2)= -eps
4737  bxs= (bs(1)).cr.(bs(2))
4738  arg= (bxs+co).cq.(bxs-co)
4739  IF(arg(2).eq.0.d0) arg(2)= eps
4740  lbxs= arg(1).fln.arg(2)
4741 *
4742  bs(1)= 1.d0-4.d0*(mt*mt)/ps
4743  bs(2)= -eps
4744  bxt= (bs(1)).cr.(bs(2))
4745  arg= (bxt+co).cq.(bxt-co)
4746  IF(arg(2).eq.0.d0) arg(2)= eps
4747  lbxt= arg(1).fln.arg(2)
4748 *
4749  bs(1)= 1.d0-4.d0*rmbs/ps
4750  bs(2)= -eps
4751  bxb= (bs(1)).cr.(bs(2))
4752  arg= (bxb+co).cq.(bxb-co)
4753  IF(arg(2).eq.0.d0) arg(2)= eps
4754  lbxb= arg(1).fln.arg(2)
4755 *
4756  bxei= co.cq.bxe
4757  bxmui= co.cq.bxmu
4758  bxtaui= co.cq.bxtau
4759  bxui= co.cq.bxu
4760  bxdi= co.cq.bxd
4761  bxci= co.cq.bxc
4762  bxsi= co.cq.bxs
4763  bxti= co.cq.bxt
4764  bxbi= co.cq.bxb
4765  bxeis= 1.d0/(1.d0-4.d0*(me*me)/ps)
4766  bxmuis= 1.d0/(1.d0-4.d0*(mm*mm)/ps)
4767  bxtauis= 1.d0/(1.d0-4.d0*(mtl*mtl)/ps)
4768  bxuis= 1.d0/(1.d0-4.d0*(muq*muq)/ps)
4769  bxdis= 1.d0/(1.d0-4.d0*(mdq*mdq)/ps)
4770  bxcis= 1.d0/(1.d0-4.d0*rmcs/ps)
4771  bxsis= 1.d0/(1.d0-4.d0*(msq*msq)/ps)
4772  bxtis= 1.d0/(1.d0-4.d0*(mt*mt)/ps)
4773  bxbis= 1.d0/(1.d0-4.d0*rmbs/ps)
4774 *
4775  bxes= 1.d0-4.d0*(me*me)/ps
4776  bxmus= 1.d0-4.d0*(mm*mm)/ps
4777  bxtaus= 1.d0-4.d0*(mtl*mtl)/ps
4778  bxus= 1.d0-4.d0*(muq*muq)/ps
4779  bxds= 1.d0-4.d0*(mdq*mdq)/ps
4780  bxcs= 1.d0-4.d0*rmcs/ps
4781  bxss= 1.d0-4.d0*(msq*msq)/ps
4782  bxts= 1.d0-4.d0*(mt*mt)/ps
4783  bxbs= 1.d0-4.d0*rmbs/ps
4784 *
4785  sh= - 9.d0*(lbh.cp.bh)
4786  # - fz*(lbz.cp.bz)
4787  # - 2.d0*fw*(lbw.cp.bw)
4788  # +co*(
4789  # - (1.d0-6.d0*xz)*lz
4790  # - 2.d0*(1.d0-6.d0*xw)*lw
4791  # - 6.d0*(1.d0-2.d0*xw)*ls
4792  # +2.d0*(9.d0+xw*(-10.d0+24.d0*xw))
4793  # - 2.d0*xz*(5.d0-12.d0*xz)
4794  # +6.d0*xz*ls)
4795 *
4796  sh= sh/(128.d0*xw)*ps+ps/(32.d0*xw)*(
4797  # - 3.d0*xt*bxts*(bxt.cp.lbxt)-3.d0*xt*lxt*co
4798  # - 3.d0*xb*bxbs*(bxb.cp.lbxb)-3.d0*xb*lxb*co
4799  # - 3.d0*xs*bxss*(bxs.cp.lbxs)-3.d0*xs*lxs*co
4800  # - 3.d0*xc*bxcs*(bxc.cp.lbxc)-3.d0*xc*lxc*co
4801  # - 3.d0*xd*bxds*(bxd.cp.lbxd)-3.d0*xd*lxd*co
4802  # - 3.d0*xu*bxus*(bxu.cp.lbxu)-3.d0*xd*lxu*co
4803  # - xtau*bxtaus*(bxtau.cp.lbxtau)-xtau*lxtau*co
4804  # - xmu*bxmus*(bxmu.cp.lbxmu)-xmu*lxmu*co
4805  # - xe*bxes*(bxe.cp.lbxe)-xe*lxe*co+co*(
4806  # - ls*(3.d0*(xt+xb+xs+xc+xd+xu)+xtau+xmu+xe)
4807  # +6.d0*xt*(1.d0-2.d0*xt)
4808  # +6.d0*xb*(1.d0-2.d0*xb)
4809  # +6.d0*xs*(1.d0-2.d0*xs)
4810  # +6.d0*xc*(1.d0-2.d0*xc)
4811  # +6.d0*xd*(1.d0-2.d0*xd)
4812  # +6.d0*xu*(1.d0-2.d0*xu)
4813  # +2.d0*xtau*(1.d0-2.d0*xtau)
4814  # +2.d0*xmu*(1.d0-2.d0*xmu)
4815  # +2.d0*xe*(1.d0-2.d0*xe)))
4816 *
4817  dmh= - 18.d0*(bh.cp.lbh)
4818  # - 2.d0*xz*fz*(lbz.cq.bz)
4819  # - 2.d0*(1.d0-2.d0*xz)*(lbz.cp.bz)
4820  # - 4.d0*xw*fw*(lbw.cq.bw)
4821  # - 4.d0*(1.d0-2.d0*xw)*(lbw.cp.bw)
4822  # +co*(
4823  # - 2.d0*(1.d0-3.d0*xz)*lz
4824  # - 4.d0*(1.d0-3.d0*xw)*lw
4825  # - 12.d0*(1.d0-xw)*ls
4826  # +6.d0*(5.d0-2.d0*xw*(1.d0+2.d0*xw))
4827  # - 6.d0*xz*(1.d0+2.d0*xz)
4828  # +6.d0*xz*ls)
4829 *
4830  dmh= dmh/(128.d0*xw)
4831  # +1.d0/(32.d0*xw)*(
4832  # - 2.d0*xes*bxes*(lbxe.cq.bxe)
4833  # - 2.d0*xmus*bxmus*(lbxmu.cq.bxmu)
4834  # - 2.d0*xtaus*bxtaus*(lbxtau.cq.bxtau)
4835  # - 6.d0*xus*bxus*(lbxu.cq.bxu)
4836  # - 6.d0*xds*bxds*(lbxd.cq.bxd)
4837  # - 6.d0*xcs*bxcs*(lbxc.cq.bxc)
4838  # - 6.d0*xss*bxss*(lbxs.cq.bxs)
4839  # - 6.d0*xts*bxts*(lbxt.cq.bxt)
4840  # - 6.d0*xbs*bxbs*(lbxb.cq.bxb)
4841  # - 3.d0*xt*((lbxt.cp.bxt)+lxt*co)
4842  # - 3.d0*xb*((lbxb.cp.bxb)+lxb*co)
4843  # - 3.d0*xc*((lbxc.cp.bxc)+lxc*co)
4844  # - 3.d0*xs*((lbxs.cp.bxs)+lxs*co)
4845  # - 3.d0*xu*((lbxu.cp.bxu)+lxu*co)
4846  # - 3.d0*xd*((lbxd.cp.bxd)+lxd*co)
4847  # - xtau*((lbxtau.cp.bxtau)+lxtau*co)
4848  # - xmu*((lbxmu.cp.bxmu)+lxmu*co)
4849  # - xe*((lbxe.cp.bxe)+lxe*co)+co*(
4850  # - ls*(3.d0*(xt+xb+xs+xc+xd+xu)+xtau+xmu+xe)
4851  # +3.d0*xt*(2.d0+xts*bxts)
4852  # +3.d0*xb*(2.d0+xbs*bxbs)
4853  # +3.d0*xc*(2.d0+xcs*bxcs)
4854  # +3.d0*xs*(2.d0+xss*bxss)
4855  # +3.d0*xu*(2.d0+xus*bxus)
4856  # +3.d0*xd*(2.d0+xds*bxds)
4857  # +xtau*(2.d0+xtaus*bxtaus)
4858  # +xmu*(2.d0+xmus*bxmus)
4859  # +xe*(2.d0+xes*bxes)))
4860 *
4861  dmw= (9.d0*(bh.cp.lbh)
4862  # +fz*(bz.cp.lbz)
4863  # - xw*fw*(lbw.cq.bw)
4864  # +2.d0*(1.d0-12.d0*xw*xw)*(bw.cp.lbw)
4865  # +co*(
4866  # 2.d0*lw+(1.d0-6.d0*xz)*lz+6.d0*(1.d0-xz)*ls
4867  # - 2.d0*(9.d0-xw*(2.d0+36.d0*xw))
4868  # +2.d0*xz*(5.d0-12.d0*xz)))/(128.d0*xw*xw)
4869  dmw= dmw-1.d0/(32.d0*xw*xw)*(
4870  # - 3.d0*xt*bxts*(bxt.cp.lbxt)-3.d0*xt*lxt*co
4871  # - 3.d0*xb*bxbs*(bxb.cp.lbxb)-3.d0*xb*lxb*co
4872  # - 3.d0*xs*bxss*(bxs.cp.lbxs)-3.d0*xs*lxs*co
4873  # - 3.d0*xc*bxcs*(bxc.cp.lbxc)-3.d0*xc*lxc*co
4874  # - 3.d0*xd*bxds*(bxd.cp.lbxd)-3.d0*xd*lxd*co
4875  # - 3.d0*xu*bxus*(bxu.cp.lbxu)-3.d0*xd*lxu*co
4876  # - xtau*bxtaus*(bxtau.cp.lbxtau)-xtau*lxtau*co
4877  # - xmu*bxmus*(bxmu.cp.lbxmu)-xmu*lxmu*co
4878  # - xe*bxes*(bxe.cp.lbxe)-xe*lxe*co
4879  # +co*(
4880  # - ls*(3.d0*(xt+xb+xs+xc+xd+xu)+xtau+xmu+xe)
4881  # +6.d0*xt*(1.d0-2.d0*xt)
4882  # +6.d0*xb*(1.d0-2.d0*xb)
4883  # +6.d0*xs*(1.d0-2.d0*xs)
4884  # +6.d0*xc*(1.d0-2.d0*xc)
4885  # +6.d0*xd*(1.d0-2.d0*xd)
4886  # +6.d0*xu*(1.d0-2.d0*xu)
4887  # +2.d0*xtau*(1.d0-2.d0*xtau)
4888  # +2.d0*xmu*(1.d0-2.d0*xmu)
4889  # +2.d0*xe*(1.d0-2.d0*xe)))
4890 *
4891  dmz= (-0.25d0+(xz-3.d0*xz))*(lbz.cq.bz)
4892  # +2.d0*(1-6.d0*xz)*(bz.cp.lbz)+
4893  # co*(-4.d0+30.d0*xz+3.d0*(lz+ls))
4894 *
4895  dmz= dmz/(64.d0*xw)
4896 *
4897  d2mh= (2.d0*fw*bwis*co
4898  # +fz*bzis*co
4899  # -9.d0*(lbh.cp.bh)
4900  # +2.d0*xz*xz*fz*(lbz.cp.bzic)
4901  # -2.d0*xz*(1.d0-12.d0*xz)*(lbz.cp.bzi)
4902  # -(lbz.cp.bz)
4903  # +4.d0*xw*xw*fz*(lbw.cp.bwic)
4904  # -4.d0*xw*(1.d0-12.d0*xw)*(lbw.cp.bwi)
4905  # -2.d0*(lbw.cp.bw)
4906  # +co*(
4907  # -6.d0*ls-lz-2.d0*lw+9.d0+4.d0*xw*(1+3.d0*xw)+
4908  # 2.d0*xz*(1.d0+3.d0*xz)))/(64.d0*xw*ps)
4909 *
4910  d2mh= d2mh+1.d0/(32.d0*xw*ps)*(
4911  # 4.d0*xec*(lbxe*bxeis)
4912  # +2.d0*bxei
4913  # -16.d0*xec*(lbxe.cp.bxei)
4914  # +4.d0*xmuc*(lbxmu*bxmuis)
4915  # +2.d0*bxmui
4916  # -16.d0*xmuc*(lbxmu.cp.bxmui)
4917  # +4.d0*xtauc*(lbxtau*bxtauis)
4918  # +2.d0*bxtaui
4919  # -16.d0*xtauc*(lbxtau.cp.bxtaui)
4920  # +12.d0*xuc*(lbxu*bxuis)
4921  # +6.d0*bxui
4922  # -48.d0*xuc*(lbxu.cp.bxui)
4923  # +12.d0*xdc*(lbxd*bxdis)
4924  # +6.d0*bxdi
4925  # -48.d0*xdc*(lbxd.cp.bxdi)
4926  # +12.d0*xcc*(lbxc*bxcis)
4927  # +6.d0*bxci
4928  # -48.d0*xcc*(lbxc.cp.bxci)
4929  # +12.d0*xsc*(lbxs*bxsis)
4930  # +6.d0*bxsi
4931  # -48.d0*xsc*(lbxs.cp.bxsi)
4932  # +12.d0*xtc*(lbxt*bxtis)
4933  # +6.d0*bxti
4934  # -48.d0*xtc*(lbxu.cp.bxti)
4935  # +12.d0*xbc*(lbxb*bxbis)
4936  # +6.d0*bxbi
4937  # -48.d0*xbc*(lbxb.cp.bxbi)+
4938  # co*(
4939  # xec*bxes
4940  # +xmuc*bxmus
4941  # +xtauc*bxtaus
4942  # +xuc*bxus
4943  # +xdc*bxds
4944  # +xcc*bxcs
4945  # +xsc*bxss
4946  # +xtc*bxts
4947  # +xbc*bxbs))
4948 *
4949  dmwh= (2.d0*xw*fw*bwis*co
4950  # +9.d0*(lbh.cp.bh)
4951  # +xz*fz*(lbz.cq.bz)
4952  # +(1.d0-2.d0*xz)*(lbz.cp.bz)
4953  # - 4.d0*xw*xw*fw*(lbw.cp.bwic)
4954  # - xw*(1.d0+xw*xw*(-10.d0+48.d0*xw))*(lbw.cq.bw)
4955  # +2.d0*(lbw.cp.bw)
4956  # +co*(
4957  # +2.d0*lw
4958  # +(1.d0-3.d0*xz)*lz
4959  # +3.d0*(2.d0-xz)*ls
4960  # - (15.d0+xw*(-2.d0+12.d0*xw))
4961  # +3.d0*xz*(1.d0+2.d0*xz)))/(64.d0*xw*xw*ps)
4962 *
4963  dmzh= (2.d0*fz*bzis*co
4964  # - 4.d0*xs*fz*(lbz.cp.bzic)
4965  # - 3.d0*(1.d0+xz*(-6.d0+24.d0*xz))*(lbz.cq.bz)
4966  # +4.d0*(lbz.cp.bz)
4967  # +co*(
4968  # +6.d0*ls
4969  # +6.d0*lz
4970  # - 4.d0*(1.d0+6.d0*xz)))/(128.d0*xw*ps)
4971 *
4972  dmzw= (fz*(lbz.cq.bz)
4973  # - 8.d0*(1.d0-6.d0*xz)*(lbz.cp.bz)
4974  # +co*(
4975  # - 12.d0*ls
4976  # - 12.d0*lz
4977  # +8.d0*(2.d0-15.d0*xz)))/(256.d0*xw*xw*ps)
4978 *
4979  dmww= (xw*(1.d0-4.d0*xw*(1.d0-2.d0*xw))*bwis*co
4980  # - 18.d0*(lbh.cp.bh)
4981  # - 2.d0*fz*(lbz.cp.bz)
4982  # - 2.d0*xw*xw*fw*(lbw.cp.bwic)
4983  # +2.d0*xw*(1.d0-12.d0*xw*xw)*(lbw.cq.bw)
4984  # - 4.d0*(lbw.cp.bw)
4985  # +co*(
4986  # - 4.d0*lw
4987  # - 2.d0*(1.d0-6.d0*xz)*lz
4988  # - 12.d0*(1.d0-xz)*ls
4989  # +4.d0*(9.d0-xw*(1.d0-6.d0*xw))
4990  # - 4.d0*xz*(5.d0-12.d0*xz)))/(128.d0*xw*xw*xw*ps)
4991  dmww= dmww+1.d0/(162.d0*xw*xw*xw*ps)*(
4992  # - 3.d0*xt*bxts*(bxt.cp.lbxt)-3.d0*xt*lxt*co
4993  # - 3.d0*xb*bxbs*(bxb.cp.lbxb)-3.d0*xb*lxb*co
4994  # - 3.d0*xs*bxss*(bxs.cp.lbxs)-3.d0*xs*lxs*co
4995  # - 3.d0*xc*bxcs*(bxc.cp.lbxc)-3.d0*xc*lxc*co
4996  # - 3.d0*xd*bxds*(bxd.cp.lbxd)-3.d0*xd*lxd*co
4997  # - 3.d0*xu*bxus*(bxu.cp.lbxu)-3.d0*xd*lxu*co
4998  # - xtau*bxtaus*(bxtau.cp.lbxtau)-xtau*lxtau*co
4999  # - xmu*bxmus*(bxmu.cp.lbxmu)-xmu*lxmu*co
5000  # - xe*bxes*(bxe.cp.lbxe)-xe*lxe*co+co*(
5001  # - ls*(3.d0*(xt+xb+xs+xc+xd+xu)+xtau+xmu+xe)
5002  # +6.d0*xt*(1.d0-2.d0*xt)
5003  # +6.d0*xb*(1.d0-2.d0*xb)
5004  # +6.d0*xs*(1.d0-2.d0*xs)
5005  # +6.d0*xc*(1.d0-2.d0*xc)
5006  # +6.d0*xd*(1.d0-2.d0*xd)
5007  # +6.d0*xu*(1.d0-2.d0*xu)
5008  # +2.d0*xtau*(1.d0-2.d0*xtau)
5009  # +2.d0*xmu*(1.d0-2.d0*xmu)
5010  # +2.d0*xe*(1.d0-2.d0*xe)))
5011 *
5012  dmzz= (fz*bzis*co
5013  # - 2.d0*xz*fz*(lbz.cp.bzic)
5014  # +8.d0*xz*(1.d0-6.d0*xz)*(lbz.cq.bz)
5015  # - 48.d0*xz*(lbz.cp.bz)
5016  # +4.d0*(1.d0+42.d0*xz)*co)/(256.d0*xw*xz*ps)
5017 *
5018  value(1,1:2)= sh(1:2)
5019  value(2,1:2)= dmh(1:2)
5020  value(3,1:2)= dmw(1:2)
5021  value(4,1:2)= dmz(1:2)
5022  value(5,1:2)= d2mh(1:2)
5023  value(6,1:2)= dmwh(1:2)
5024  value(7,1:2)= dmzh(1:2)
5025  value(8,1:2)= dmzw(1:2)
5026  value(9,1:2)= dmww(1:2)
5027  value(10,1:2)= dmzz(1:2)
5028 *
5029  RETURN
5030 *

◆ hto_dzero()

real*8 function hto_dzero (   A0,
  B0,
  EPS,
  MAXF,
  F,
  MODE 
)

Definition at line 2683 of file CALLING_cpHTO.f.

2683  IMPLICIT REAL*8 (a-h,o-z)
2684 C Based on
2685 C
2686 C J.C.P. Bus and T.J. Dekker, Two Efficient Algorithms with
2687 C Guaranteed Convergence for Finding a Zero of a Function,
2688 C ACM Trans. Math. Software 1 (1975) 330-345.
2689 C
2690 C (MODE = 1: Algorithm M; MODE = 2: Algorithm R)
2691 *
2692 * CHARACTER*80 ERRTXT
2693  real*8 hto_dzero
2694  LOGICAL LMT
2695  dimension im1(2),im2(2),lmt(2)
2696  parameter(z1 = 1, half = z1/2)
2697  DATA im1 /2,3/, im2 /-1,3/
2698 *
2699  hto_dzero = 0.d0 ! G.W. to prevent compiler warning
2700  IF(mode .NE. 1 .AND. mode .NE. 2) THEN
2701  c=0
2702 * WRITE(ERRTXT,101) MODE
2703  print 101,mode
2704 * WRITE(6,*) ERRTXT
2705  GO TO 99
2706  ENDIF
2707  fa=f(b0)
2708  fb=f(a0)
2709  IF(fa*fb .GT. 0) THEN
2710  c=0
2711 * WRITE(ERRTXT,102) A0,B0
2712  print 102,a0,b0
2713 * WRITE(6,*) ERRTXT
2714  GO TO 99
2715  ENDIF
2716  atl=abs(eps)
2717  b=a0
2718  a=b0
2719  lmt(2)=.true.
2720  mf=2
2721  1 c=a
2722  fc=fa
2723  2 ie=0
2724  3 IF(abs(fc) .LT. abs(fb)) THEN
2725  IF(c .NE. a) THEN
2726  d=a
2727  fd=fa
2728  ENDIF
2729  a=b
2730  b=c
2731  c=a
2732  fa=fb
2733  fb=fc
2734  fc=fa
2735  ENDIF
2736  tol=atl*(1+abs(c))
2737  h=half*(c+b)
2738  hb=h-b
2739  IF(abs(hb) .GT. tol) THEN
2740  IF(ie .GT. im1(mode)) THEN
2741  w=hb
2742  ELSE
2743  tol=tol*sign(z1,hb)
2744  p=(b-a)*fb
2745  lmt(1)=ie .LE. 1
2746  IF(lmt(mode)) THEN
2747  q=fa-fb
2748  lmt(2)=.false.
2749  ELSE
2750  fdb=(fd-fb)/(d-b)
2751  fda=(fd-fa)/(d-a)
2752  p=fda*p
2753  q=fdb*fa-fda*fb
2754  ENDIF
2755  IF(p .LT. 0) THEN
2756  p=-p
2757  q=-q
2758  ENDIF
2759  IF(ie .EQ. im2(mode)) p=p+p
2760  IF(p .EQ. 0 .OR. p .LE. q*tol) THEN
2761  w=tol
2762  ELSEIF(p .LT. hb*q) THEN
2763  w=p/q
2764  ELSE
2765  w=hb
2766  ENDIF
2767  ENDIF
2768  d=a
2769  a=b
2770  fd=fa
2771  fa=fb
2772  b=b+w
2773  mf=mf+1
2774  IF(mf .GT. maxf) THEN
2775 * WRITE(6,*) "Error in HTO_DZERO: TOO MANY FUNCTION CALLS"
2776  print*,"Error in HTO_DZERO: TOO MANY FUNCTION CALLS"
2777  GO TO 99
2778  ENDIF
2779  fb=f(b)
2780  IF(fb .EQ. 0 .OR. sign(z1,fc) .EQ. sign(z1,fb)) GO TO 1
2781  IF(w .EQ. hb) GO TO 2
2782  ie=ie+1
2783  GO TO 3
2784  ENDIF
2785  hto_dzero=c
2786  99 CONTINUE
2787  RETURN
2788  101 FORMAT('Error in DZERO: MODE = ',i3,' ILLEGAL')
2789  102 FORMAT('Error in DZERO: F(A) AND F(B) HAVE THE SAME SIGN, A = ',
2790  1 1p,d15.8,', B = ',d15.8)
2791 *

◆ hto_evnfthr()

subroutine hto_evnfthr ( real*8  MC2,
real*8  MB2,
real*8  MT2 
)

Definition at line 2451 of file CALLING_cpHTO.f.

2451  USE hto_asinp
2452  USE hto_frrat
2453  USE hto_asfthr
2454 *
2455  IMPLICIT NONE
2456  real*8 mc2,mb2,mt2,r20,r2c,r2b,r2t,hto_as,hto_asnf1,
2457  # ASC3,ASB4,AST5,SC,SB,ST
2458 *
2459 * ---------------------------------------------------------------------
2460 *
2461 * ..input common blocks
2462 *
2463 *
2464 * ..output common blocks
2465 *
2466 
2467 * ---------------------------------------------------------------------
2468 *
2469 * ..coupling constants at and evolution distances to/between thresholds
2470 *
2471  r20 = m20 * exp(-logfr)
2472 *
2473 * ..charm
2474 *
2475  m2c = mc2
2476  r2c = m2c * r20/m20
2477  asc3 = hto_as(r2c,r20,as0,3)
2478  sc = log(as0 / asc3)
2479  asc = hto_asnf1(asc3,-logfr,3)
2480 *
2481 * ..bottom
2482 *
2483  m2b = mb2
2484  r2b = m2b * r20/m20
2485  asb4 = hto_as(r2b,r2c,asc,4)
2486  sb = log(asc / asb4)
2487  asb = hto_asnf1(asb4,-logfr,4)
2488 *
2489 * ..top
2490 *
2491  m2t = mt2
2492  r2t = m2t * r20/m20
2493  ast5 = hto_as(r2t,r2b,asb,5)
2494  st = log(asb / ast5)
2495  ast = hto_asnf1(ast5,-logfr,5)
2496 
2497  RETURN

◆ hto_findalphasr0()

real*8 function hto_findalphasr0 ( real*8  ASI)

Definition at line 2142 of file CALLING_cpHTO.f.

2142  USE hto_dzpar
2143 *
2144  IMPLICIT NONE
2145 *
2146  real*8 hto_alphas,hto_findalphasr0,asi
2147 *
2148  CALL hto_initalphasr0(iordc,fr2c,r0c,asi,mcc,mbc,mtc)
2149 *
2150  hto_findalphasr0 = hto_alphas(murc) - asmurc ! solve equal to zero
2151 
2152 
2153  RETURN

◆ hto_fmmsplinesingleht()

subroutine hto_gridht::hto_fmmsplinesingleht ( real*8, dimension(gdim)  b,
real*8, dimension(gdim)  c,
real*8, dimension(gdim)  d,
integer  top,
integer  gdim 
)

Definition at line 4131 of file CALLING_cpHTO.f.

4131 *
4132 *---------------------------------------------------------------------------
4133 *
4134  INTEGER k,n,i,top,gdim,l
4135 *
4136  real*8, dimension(103) :: xc,yc
4137  real*8, dimension(103) :: x,y
4138 *
4139  real*8, DIMENSION(gdim) :: b
4140 * linear coeff
4141 *
4142  real*8, DIMENSION(gdim) :: c
4143 * quadratic coeff.
4144 *
4145  real*8, DIMENSION(gdim) :: d
4146 * cubic coeff.
4147 *
4148  real*8 :: t
4149  real*8,PARAMETER:: zero=0.0, two=2.0, three=3.0
4150 *
4151 * The grid
4152 *
4153 *
4154  DATA (xc(i),i=1,103)/
4155  # 90.d0,95.d0,100.d0,105.d0,110.d0,115.d0,120.d0,
4156  # 125.d0,130.d0,135.d0,140.d0,145.d0,150.d0,155.d0,160.d0,165.d0,
4157  # 170.d0,175.d0,180.d0,185.d0,190.d0,195.d0,200.d0,210.d0,220.d0,
4158  # 230.d0,240.d0,250.d0,260.d0,270.d0,280.d0,290.d0,300.d0,310.d0,
4159  # 320.d0,330.d0,340.d0,350.d0,360.d0,370.d0,380.d0,390.d0,400.d0,
4160  # 410.d0,420.d0,430.d0,440.d0,450.d0,460.d0,470.d0,480.d0,490.d0,
4161  # 500.d0,510.d0,520.d0,530.d0,540.d0,550.d0,560.d0,570.d0,580.d0,
4162  # 590.d0,600.d0,610.d0,620.d0,630.d0,640.d0,650.d0,660.d0,670.d0,
4163  # 680.d0,690.d0,700.d0,710.d0,720.d0,730.d0,740.d0,750.d0,760.d0,
4164  # 770.d0,780.d0,790.d0,800.d0,810.d0,820.d0,830.d0,840.d0,850.d0,
4165  # 860.d0,870.d0,880.d0,890.d0,900.d0,910.d0,920.d0,930.d0,940.d0,
4166  # 950.d0,960.d0,970.d0,980.d0,990.d0,1000.d0/
4167 *
4168  DATA (yc(i),i=1,103)/
4169  # 2.20d-3,2.32d-3,2.46d-3,2.62d-3,2.82d-3,3.09d-3,3.47d-3,4.03d-3,
4170  # 4.87d-3,6.14d-3,8.12d-3,1.14d-2,1.73d-2,3.02d-2,8.29d-2,2.46d-1,
4171  # 3.80d-1,5.00d-1,6.31d-1,8.32d-1,1.04d0,1.24d0,1.43d0,1.85d0,
4172  # 2.31d0,2.82d0,3.40d0,4.04d0,4.76d0,5.55d0,6.43d0,7.39d0,8.43d0,
4173  # 9.57d0,10.8d0,12.1d0,13.5d0,15.2d0,17.6d0,20.2d0,23.1d0,26.1d0,
4174  # 29.2d0,32.5d0,35.9d0,39.4d0,43.1d0,46.9d0,50.8d0,54.9d0,59.1d0,
4175  # 63.5d0,68.0d0,72.7d0,77.6d0,82.6d0,87.7d0,93.1d0,98.7d0,104.d0,
4176  # 110.d0,116.d0,123.d0,129.d0,136.d0,143.d0,150.d0,158.d0,166.d0,
4177  # 174.d0,182.d0,190.d0,199.d0,208.d0,218.d0,227.d0,237.d0,248.d0,
4178  # 258.d0,269.d0,281.d0,292.d0,304.d0,317.d0,330.d0,343.d0,357.d0,
4179  # 371.d0,386.d0,401.d0,416.d0,432.d0,449.d0,466.d0,484.d0,502.d0,
4180  # 521.d0,540.d0,560.d0,581.d0,602.d0,624.d0,647.d0/
4181 *
4182  n= 103
4183  FORALL(l=1:103)
4184  x(l)= xc(l)
4185  y(l)= yc(l)
4186  ENDFORALL
4187 
4188 *.....Set up tridiagonal system.........................................
4189 * b=diagonal, d=offdiagonal, c=right-hand side
4190 *
4191  d(1)= x(2)-x(1)
4192  c(2)= (y(2)-y(1))/d(1)
4193  DO k= 2,n-1
4194  d(k)= x(k+1)-x(k)
4195  b(k)= two*(d(k-1)+d(k))
4196  c(k+1)= (y(k+1)-y(k))/d(k)
4197  c(k)= c(k+1)-c(k)
4198  END DO
4199 *
4200 *.....End conditions. third derivatives at x(1) and x(n) obtained
4201 * from divided differences.......................................
4202 *
4203  b(1)= -d(1)
4204  b(n)= -d(n-1)
4205  c(1)= zero
4206  c(n)= zero
4207  IF (n > 3) THEN
4208  c(1)= c(3)/(x(4)-x(2))-c(2)/(x(3)-x(1))
4209  c(n)= c(n-1)/(x(n)-x(n-2))-c(n-2)/(x(n-1)-x(n-3))
4210  c(1)= c(1)*d(1)*d(1)/(x(4)-x(1))
4211  c(n)= -c(n)*d(n-1)*d(n-1)/(x(n)-x(n-3))
4212  END IF
4213 *
4214  DO k=2,n ! forward elimination
4215  t= d(k-1)/b(k-1)
4216  b(k)= b(k)-t*d(k-1)
4217  c(k)= c(k)-t*c(k-1)
4218  END DO
4219 *
4220  c(n)= c(n)/b(n)
4221 *
4222 * back substitution ( makes c the sigma of text)
4223 *
4224  DO k=n-1,1,-1
4225  c(k)= (c(k)-d(k)*c(k+1))/b(k)
4226  END DO
4227 *
4228 *.....Compute polynomial coefficients...................................
4229 *
4230  b(n)= (y(n)-y(n-1))/d(n-1)+d(n-1)*(c(n-1)+c(n)+c(n))
4231  DO k=1,n-1
4232  b(k)= (y(k+1)-y(k))/d(k)-d(k)*(c(k+1)+c(k)+c(k))
4233  d(k)= (c(k+1)-c(k))/d(k)
4234  c(k)= three*c(k)
4235  END DO
4236  c(n)= three*c(n)
4237  d(n)= d(n-1)
4238 *
4239  RETURN
4240 *

◆ hto_fmmsplinesinglel()

subroutine hto_gridlow::hto_fmmsplinesinglel ( real*8, dimension(gdim)  b,
real*8, dimension(gdim)  c,
real*8, dimension(gdim)  d,
integer  top,
integer  gdim 
)

Definition at line 4369 of file CALLING_cpHTO.f.

4369 *
4370 *---------------------------------------------------------------------------
4371 *
4372  INTEGER k,n,i,top,gdim,l
4373 *
4374  real*8, dimension(22) :: xc,yc
4375  real*8, dimension(22) :: x,y
4376 *
4377  real*8, DIMENSION(gdim) :: b
4378 * linear coeff
4379 *
4380  real*8, DIMENSION(gdim) :: c
4381 * quadratic coeff.
4382 *
4383  real*8, DIMENSION(gdim) :: d
4384 * cubic coeff.
4385 *
4386  real*8 :: t
4387  real*8,PARAMETER:: zero=0.0, two=2.0, three=3.0
4388 *
4389 * The grid
4390 *
4391 *
4392  DATA (xc(i),i=1,22)/
4393  # 190.d0,191.d0,192.d0,193.d0,194.d0,195.d0,196.d0,197.d0,198.d0,
4394  # 199.d0,200.d0,240.d0,241.d0,242.d0,243.d0,244.d0,245.d0,246.d0,
4395  # 247.d0,248.d0,249.d0,250.d0/
4396 *
4397  DATA (yc(i),i=1,22)/
4398  # 0.10346d1,0.10750d1,0.11151d1,0.11549d1,0.11942d1,0.12329d1,
4399  # 0.12708d1,0.13083d1,0.13456d1,0.13832d1,0.14212d1,
4400  # 0.32401d1,0.32994d1,0.33593d1,0.34200d1,0.34813d1,0.35433d1,
4401  # 0.36061d1,0.36695d1,0.37336d1,0.37984d1,0.38640d1/
4402 *
4403  n= 22
4404  FORALL(l=1:22)
4405  x(l)= xc(l)
4406  y(l)= yc(l)
4407  ENDFORALL
4408 
4409 *.....Set up tridiagonal system.........................................
4410 * b=diagonal, d=offdiagonal, c=right-hand side
4411 *
4412  d(1)= x(2)-x(1)
4413  c(2)= (y(2)-y(1))/d(1)
4414  DO k= 2,n-1
4415  d(k)= x(k+1)-x(k)
4416  b(k)= two*(d(k-1)+d(k))
4417  c(k+1)= (y(k+1)-y(k))/d(k)
4418  c(k)= c(k+1)-c(k)
4419  END DO
4420 *
4421 *.....End conditions. third derivatives at x(1) and x(n) obtained
4422 * from divided differences.......................................
4423 *
4424  b(1)= -d(1)
4425  b(n)= -d(n-1)
4426  c(1)= zero
4427  c(n)= zero
4428  IF (n > 3) THEN
4429  c(1)= c(3)/(x(4)-x(2))-c(2)/(x(3)-x(1))
4430  c(n)= c(n-1)/(x(n)-x(n-2))-c(n-2)/(x(n-1)-x(n-3))
4431  c(1)= c(1)*d(1)*d(1)/(x(4)-x(1))
4432  c(n)= -c(n)*d(n-1)*d(n-1)/(x(n)-x(n-3))
4433  END IF
4434 *
4435  DO k=2,n ! forward elimination
4436  t= d(k-1)/b(k-1)
4437  b(k)= b(k)-t*d(k-1)
4438  c(k)= c(k)-t*c(k-1)
4439  END DO
4440 *
4441  c(n)= c(n)/b(n)
4442 *
4443 * back substitution ( makes c the sigma of text)
4444 *
4445  DO k=n-1,1,-1
4446  c(k)= (c(k)-d(k)*c(k+1))/b(k)
4447  END DO
4448 *
4449 *.....Compute polynnomial coefficients...................................
4450 *
4451  b(n)= (y(n)-y(n-1))/d(n-1)+d(n-1)*(c(n-1)+c(n)+c(n))
4452  DO k=1,n-1
4453  b(k)= (y(k+1)-y(k))/d(k)-d(k)*(c(k+1)+c(k)+c(k))
4454  d(k)= (c(k+1)-c(k))/d(k)
4455  c(k)= three*c(k)
4456  END DO
4457  c(n)= three*c(n)
4458  d(n)= d(n-1)
4459 *
4460  RETURN
4461 *

◆ hto_gh()

subroutine hto_gh ( real*8  muh,
real*8  cpgh 
)

Definition at line 5094 of file CALLING_cpHTO.f.

5094  USE hto_masses
5095  USE hto_aux_hcp
5096  USE hto_aux_hbb
5097  USE hto_cmplx_rootz
5098  USE hto_acmplx_pro
5099  USE hto_acmplx_rat
5100  USE hto_full_ln
5101  USE hto_units
5102  USE hto_ferbos
5103  USE hto_rootw
5104  USE hto_hbb_cp
5105  USE hto_set_phys_const
5106  USE hto_root_find2
5107 *
5108  IMPLICIT NONE
5109 *
5110  INTEGER i
5111  real*8 muh,scals,x1,x2,xacc,tgh,itgh,ghf,ghb,ght,cpgh
5112  real*8, dimension(2) :: cmw,cmz
5113 *
5114  scalec= muh
5115  scals= scalec*scalec
5116 *
5117  xtop= mt*mt/(muh*muh)
5118  xb= mb*mb/(muh*muh)
5119 *
5120  cxe= (me*me)/scals
5121  cxmu= (mm*mm)/scals
5122  cxtau= (mtl*mtl)/scals
5123  cxu= (muq*muq)/scals
5124  cxd= (mdq*mdq)/scals
5125  cxc= (mcq*mcq)/scals
5126  cxs= (msq*msq)/scals
5127  cxt= (mt*mt)/scals
5128  cxb= (mb*mb)/scals
5129 *
5130  cxes= cxe*cxe
5131  cxmus= cxmu*cxmu
5132  cxtaus= cxtau*cxtau
5133  cxus= cxu*cxu
5134  cxds= cxd*cxd
5135  cxcs= cxc*cxc
5136  cxss= cxs*cxs
5137  cxts= cxt*cxt
5138  cxbs= cxb*cxb
5139  cxtmb= cxt-cxb
5140  cxtmbs= cxtmb*cxtmb
5141  cxtmbi= 1.d0/cxtmb
5142 *
5143  cxtc= cxts*cxt
5144  cxbc= cxbs*cxb
5145 *
5146  clxe= log(cxe)
5147  clxmu= log(cxmu)
5148  clxtau= log(cxtau)
5149  clxu= log(cxu)
5150  clxd= log(cxd)
5151  clxc= log(cxc)
5152  clxs= log(cxs)
5153  clxt= log(cxt)
5154  clxb= log(cxb)
5155 *
5156  cmw(1)= swr
5157  cmw(2)= swi
5158  cmz(1)= szr
5159  cmz(2)= szi
5160 *
5161  rcmw= cmw(1).crz.cmw(2)
5162 *
5163  cxw(1)= swr/scals
5164  cxw(2)= swi/scals
5165  cxz(1)= szr/scals
5166  cxz(2)= szi/scals
5167  cxws= cxw.cp.cxw
5168  cxwc= cxws.cp.cxw
5169  cxwi= co.cq.cxw
5170 *
5171  clw= cxw(1).fln.cxw(2)
5172 *
5173  ccts= cmw.cq.cmz
5174  csts= co-ccts
5175  cctq= ccts.cp.ccts
5176  cctvi= cctq.cp.ccts
5177  clcts= ccts(1).fln.ccts(2)
5178 *
5179  xq= cxt+cxb
5180  cxq= cxb+cxc+cxs+cxu+cxd
5181  cxqs= cxbs+cxcs+cxss+cxus+cxds
5182  cxl= cxtau+cxmu+cxe
5183  cxls= cxtaus+cxmus+cxes
5184 *
5185  clwtb= cxtmbs*co+cxws-2.d0*xq*cxw
5186 *
5187  cpw= swr*co+swi*ci
5188  cpz= szr*co+szi*ci
5189 *
5190  g_f= 1.16637d-5
5191 *
5192  muhcp= muh
5193 *
5194  IF(muhcp.ge.900.d0) THEN
5195  x2= 1.d3/muh
5196  ELSEIF((muhcp.gt.600.d0).and.(muhcp.lt.900.d0)) THEN
5197  x2= 4.d2/muh
5198  ELSEIF(muhcp.lt.160.d0) THEN
5199  x2= 1.d0/muh
5200  ELSE
5201  x2= 2.d2/muh
5202  ENDIF
5203  xacc= 1.d-10
5204  DO i=3,0,-1
5205  ifb= i
5206  x1= -1.d0/muh
5207 *
5208  inc= 0
5209  tgh= muh*hto_zeroin(hto_sshh,x1,x2,zero,xacc)
5210 *
5211 * T
5212 *
5213  IF(i==0) THEN
5214 *
5215 * LF
5216 *
5217  ELSEIF(i==1) THEN
5218  ghf= tgh
5219 *
5220 * top
5221 *
5222  ELSEIF(i==2) THEN
5223  ght= tgh
5224 *
5225 * bos
5226 *
5227  ELSEIF(i==3) THEN
5228  ghb= tgh
5229 *
5230  ENDIF
5231 
5232  IF(inc==1) THEN
5233  print*,'---- Warning ------------------------ '
5234  IF(i==0) THEN
5235  print*,' inconsistent interval for tot '
5236  ELSEIF(i==1) THEN
5237  print*,' inconsistent interval for lf '
5238  ELSEIF(i==2) THEN
5239  print*,' inconsistent interval for top '
5240  ELSEIF(i==3) THEN
5241  print*,' inconsistent interval for bos '
5242  ENDIF
5243  print*,'------------------------------------ '
5244  ENDIF
5245  ENDDO
5246 *
5247  xacc= 1.d-20
5248  DO i=3,0,-1
5249  ifb= i
5250  IF(i==0) THEN
5251  x1= 0.9d0*tgh/muh
5252  x2= 1.1d0*tgh/muh
5253  ELSE IF(i==1) THEN
5254  x1= 0.9d0*ghf/muh
5255  x2= 1.1d0*ghf/muh
5256  ELSE IF(i==2) THEN
5257  x1= 0.9d0*ght/muh
5258  x2= 1.1d0*ght/muh
5259  ELSE IF(i==3) THEN
5260  x1= 0.9d0*ghb/muh
5261  x2= 1.1d0*ghb/muh
5262  ENDIF
5263  inc= 0
5264  itgh= muh*hto_zeroin(hto_sshh,x1,x2,zero,xacc)
5265  IF(i==0) THEN
5266 * print 116,itgH
5267  cpgh= itgh
5268  ELSEIF(i==1) THEN
5269 * print 117,itgH
5270  ELSEIF(i==2) THEN
5271 * print 1118,itgH
5272  ELSEIF(i==3) THEN
5273 * print 118,itgH
5274  ENDIF
5275  IF(inc==1) THEN
5276  print*,'---- Warning ------------------------ '
5277  IF(i==0) THEN
5278  print*,' inconsistent interval for tot '
5279  ELSEIF(i==1) THEN
5280  print*,' inconsistent interval for lf '
5281  ELSEIF(i==2) THEN
5282  print*,' inconsistent interval for top '
5283  ELSEIF(i==3) THEN
5284  print*,' inconsistent interval for bos '
5285  ENDIF
5286 * print*,'------------------------------------ '
5287  ENDIF
5288  ENDDO
5289 * print*,' '
5290 * print*,'+++++++++++++++++++++++++++++++++++++++++++++++++++++'
5291 *
5292  116 format(' gH Total [GeV] =',e20.7)
5293  117 format(' gH LightF [GeV] =',e20.5)
5294  1118 format(' gH top [GeV] =',e20.5)
5295  118 format(' gH Bos [GeV] =',e20.5)
5296 *
5297  RETURN
5298 *

◆ hto_gridht()

subroutine hto_gridht ( real*8  mass,
real*8  evalue 
)

Definition at line 4106 of file CALLING_cpHTO.f.

4106 *
4107  IMPLICIT NONE
4108 *
4109  INTEGER i,top,gdim
4110  real*8 u,value,evalue,mass
4111  real*8, dimension(103) :: bc,cc,dc
4112 *
4113 * u value of M_H at which the spline is to be evaluated
4114 *
4115  gdim= 103
4116 *
4117  CALL hto_fmmsplinesingleht(bc,cc,dc,top,gdim)
4118 *
4119  u= mass
4120  CALL hto_seval3singleht(u,bc,cc,dc,top,gdim,value)
4121 *
4122  evalue= value
4123 *
4124  RETURN
4125 *
4126 *-----------------------------------------------------------------------
4127 *
4128  CONTAINS
4129 *
4130  SUBROUTINE hto_fmmsplinesingleht(b,c,d,top,gdim)
4131 *
4132 *---------------------------------------------------------------------------
4133 *
4134  INTEGER k,n,i,top,gdim,l
4135 *
4136  real*8, dimension(103) :: xc,yc
4137  real*8, dimension(103) :: x,y
4138 *
4139  real*8, DIMENSION(gdim) :: b
4140 * linear coeff
4141 *
4142  real*8, DIMENSION(gdim) :: c
4143 * quadratic coeff.
4144 *
4145  real*8, DIMENSION(gdim) :: d
4146 * cubic coeff.
4147 *
4148  real*8 :: t
4149  real*8,PARAMETER:: zero=0.0, two=2.0, three=3.0
4150 *
4151 * The grid
4152 *
4153 *
4154  DATA (xc(i),i=1,103)/
4155  # 90.d0,95.d0,100.d0,105.d0,110.d0,115.d0,120.d0,
4156  # 125.d0,130.d0,135.d0,140.d0,145.d0,150.d0,155.d0,160.d0,165.d0,
4157  # 170.d0,175.d0,180.d0,185.d0,190.d0,195.d0,200.d0,210.d0,220.d0,
4158  # 230.d0,240.d0,250.d0,260.d0,270.d0,280.d0,290.d0,300.d0,310.d0,
4159  # 320.d0,330.d0,340.d0,350.d0,360.d0,370.d0,380.d0,390.d0,400.d0,
4160  # 410.d0,420.d0,430.d0,440.d0,450.d0,460.d0,470.d0,480.d0,490.d0,
4161  # 500.d0,510.d0,520.d0,530.d0,540.d0,550.d0,560.d0,570.d0,580.d0,
4162  # 590.d0,600.d0,610.d0,620.d0,630.d0,640.d0,650.d0,660.d0,670.d0,
4163  # 680.d0,690.d0,700.d0,710.d0,720.d0,730.d0,740.d0,750.d0,760.d0,
4164  # 770.d0,780.d0,790.d0,800.d0,810.d0,820.d0,830.d0,840.d0,850.d0,
4165  # 860.d0,870.d0,880.d0,890.d0,900.d0,910.d0,920.d0,930.d0,940.d0,
4166  # 950.d0,960.d0,970.d0,980.d0,990.d0,1000.d0/
4167 *
4168  DATA (yc(i),i=1,103)/
4169  # 2.20d-3,2.32d-3,2.46d-3,2.62d-3,2.82d-3,3.09d-3,3.47d-3,4.03d-3,
4170  # 4.87d-3,6.14d-3,8.12d-3,1.14d-2,1.73d-2,3.02d-2,8.29d-2,2.46d-1,
4171  # 3.80d-1,5.00d-1,6.31d-1,8.32d-1,1.04d0,1.24d0,1.43d0,1.85d0,
4172  # 2.31d0,2.82d0,3.40d0,4.04d0,4.76d0,5.55d0,6.43d0,7.39d0,8.43d0,
4173  # 9.57d0,10.8d0,12.1d0,13.5d0,15.2d0,17.6d0,20.2d0,23.1d0,26.1d0,
4174  # 29.2d0,32.5d0,35.9d0,39.4d0,43.1d0,46.9d0,50.8d0,54.9d0,59.1d0,
4175  # 63.5d0,68.0d0,72.7d0,77.6d0,82.6d0,87.7d0,93.1d0,98.7d0,104.d0,
4176  # 110.d0,116.d0,123.d0,129.d0,136.d0,143.d0,150.d0,158.d0,166.d0,
4177  # 174.d0,182.d0,190.d0,199.d0,208.d0,218.d0,227.d0,237.d0,248.d0,
4178  # 258.d0,269.d0,281.d0,292.d0,304.d0,317.d0,330.d0,343.d0,357.d0,
4179  # 371.d0,386.d0,401.d0,416.d0,432.d0,449.d0,466.d0,484.d0,502.d0,
4180  # 521.d0,540.d0,560.d0,581.d0,602.d0,624.d0,647.d0/
4181 *
4182  n= 103
4183  FORALL(l=1:103)
4184  x(l)= xc(l)
4185  y(l)= yc(l)
4186  ENDFORALL
4187 
4188 *.....Set up tridiagonal system.........................................
4189 * b=diagonal, d=offdiagonal, c=right-hand side
4190 *
4191  d(1)= x(2)-x(1)
4192  c(2)= (y(2)-y(1))/d(1)
4193  DO k= 2,n-1
4194  d(k)= x(k+1)-x(k)
4195  b(k)= two*(d(k-1)+d(k))
4196  c(k+1)= (y(k+1)-y(k))/d(k)
4197  c(k)= c(k+1)-c(k)
4198  END DO
4199 *
4200 *.....End conditions. third derivatives at x(1) and x(n) obtained
4201 * from divided differences.......................................
4202 *
4203  b(1)= -d(1)
4204  b(n)= -d(n-1)
4205  c(1)= zero
4206  c(n)= zero
4207  IF (n > 3) THEN
4208  c(1)= c(3)/(x(4)-x(2))-c(2)/(x(3)-x(1))
4209  c(n)= c(n-1)/(x(n)-x(n-2))-c(n-2)/(x(n-1)-x(n-3))
4210  c(1)= c(1)*d(1)*d(1)/(x(4)-x(1))
4211  c(n)= -c(n)*d(n-1)*d(n-1)/(x(n)-x(n-3))
4212  END IF
4213 *
4214  DO k=2,n ! forward elimination
4215  t= d(k-1)/b(k-1)
4216  b(k)= b(k)-t*d(k-1)
4217  c(k)= c(k)-t*c(k-1)
4218  END DO
4219 *
4220  c(n)= c(n)/b(n)
4221 *
4222 * back substitution ( makes c the sigma of text)
4223 *
4224  DO k=n-1,1,-1
4225  c(k)= (c(k)-d(k)*c(k+1))/b(k)
4226  END DO
4227 *
4228 *.....Compute polynomial coefficients...................................
4229 *
4230  b(n)= (y(n)-y(n-1))/d(n-1)+d(n-1)*(c(n-1)+c(n)+c(n))
4231  DO k=1,n-1
4232  b(k)= (y(k+1)-y(k))/d(k)-d(k)*(c(k+1)+c(k)+c(k))
4233  d(k)= (c(k+1)-c(k))/d(k)
4234  c(k)= three*c(k)
4235  END DO
4236  c(n)= three*c(n)
4237  d(n)= d(n-1)
4238 *
4239  RETURN
4240 *
4241  END SUBROUTINE hto_fmmsplinesingleht
4242 *
4243 *------------------------------------------------------------------------
4244 *
4245  SUBROUTINE hto_seval3singleht(u,b,c,d,top,gdim,f,fp,fpp,fppp)
4246 *
4247 * ---------------------------------------------------------------------------
4248 *
4249  real*8,INTENT(IN) :: u
4250 * abscissa at which the spline is to be evaluated
4251 *
4252  INTEGER j,k,n,l,top,gdim
4253 *
4254  real*8, dimension(103) :: xc,yc
4255  real*8, dimension(103) :: x,y
4256  real*8, DIMENSION(gdim) :: b,c,d
4257 * linear,quadratic,cubic coeff
4258 *
4259  real*8,INTENT(OUT),OPTIONAL:: f,fp,fpp,fppp
4260 * function, 1st,2nd,3rd deriv
4261 *
4262  INTEGER, SAVE :: i=1
4263  real*8 :: dx
4264  real*8,PARAMETER:: two=2.0, three=3.0, six=6.0
4265 *
4266 * The grid
4267 *
4268  DATA (xc(l),l=1,103)/
4269  # 90.d0,95.d0,100.d0,105.d0,110.d0,115.d0,120.d0,
4270  # 125.d0,130.d0,135.d0,140.d0,145.d0,150.d0,155.d0,160.d0,165.d0,
4271  # 170.d0,175.d0,180.d0,185.d0,190.d0,195.d0,200.d0,210.d0,220.d0,
4272  # 230.d0,240.d0,250.d0,260.d0,270.d0,280.d0,290.d0,300.d0,310.d0,
4273  # 320.d0,330.d0,340.d0,350.d0,360.d0,370.d0,380.d0,390.d0,400.d0,
4274  # 410.d0,420.d0,430.d0,440.d0,450.d0,460.d0,470.d0,480.d0,490.d0,
4275  # 500.d0,510.d0,520.d0,530.d0,540.d0,550.d0,560.d0,570.d0,580.d0,
4276  # 590.d0,600.d0,610.d0,620.d0,630.d0,640.d0,650.d0,660.d0,670.d0,
4277  # 680.d0,690.d0,700.d0,710.d0,720.d0,730.d0,740.d0,750.d0,760.d0,
4278  # 770.d0,780.d0,790.d0,800.d0,810.d0,820.d0,830.d0,840.d0,850.d0,
4279  # 860.d0,870.d0,880.d0,890.d0,900.d0,910.d0,920.d0,930.d0,940.d0,
4280  # 950.d0,960.d0,970.d0,980.d0,990.d0,1000.d0/
4281 *
4282  DATA (yc(l),l=1,103)/
4283  # 2.20d-3,2.32d-3,2.46d-3,2.62d-3,2.82d-3,3.09d-3,3.47d-3,4.03d-3,
4284  # 4.87d-3,6.14d-3,8.12d-3,1.14d-2,1.73d-2,3.02d-2,8.29d-2,2.46d-1,
4285  # 3.80d-1,5.00d-1,6.31d-1,8.32d-1,1.04d0,1.24d0,1.43d0,1.85d0,
4286  # 2.31d0,2.82d0,3.40d0,4.04d0,4.76d0,5.55d0,6.43d0,7.39d0,8.43d0,
4287  # 9.57d0,10.8d0,12.1d0,13.5d0,15.2d0,17.6d0,20.2d0,23.1d0,26.1d0,
4288  # 29.2d0,32.5d0,35.9d0,39.4d0,43.1d0,46.9d0,50.8d0,54.9d0,59.1d0,
4289  # 63.5d0,68.0d0,72.7d0,77.6d0,82.6d0,87.7d0,93.1d0,98.7d0,104.d0,
4290  # 110.d0,116.d0,123.d0,129.d0,136.d0,143.d0,150.d0,158.d0,166.d0,
4291  # 174.d0,182.d0,190.d0,199.d0,208.d0,218.d0,227.d0,237.d0,248.d0,
4292  # 258.d0,269.d0,281.d0,292.d0,304.d0,317.d0,330.d0,343.d0,357.d0,
4293  # 371.d0,386.d0,401.d0,416.d0,432.d0,449.d0,466.d0,484.d0,502.d0,
4294  # 521.d0,540.d0,560.d0,581.d0,602.d0,624.d0,647.d0/
4295 *
4296  n= 103
4297  FORALL(l=1:103)
4298  x(l)= xc(l)
4299  y(l)= yc(l)
4300  ENDFORALL
4301 *
4302 *.....First check if u is in the same interval found on the
4303 * last call to Seval.............................................
4304 *
4305  IF ( (i<1) .OR. (i >= n) ) i=1
4306  IF ( (u < x(i)) .OR. (u >= x(i+1)) ) THEN
4307  i=1
4308 *
4309 * binary search
4310 *
4311  j= n+1
4312  DO
4313  k= (i+j)/2
4314  IF (u < x(k)) THEN
4315  j= k
4316  ELSE
4317  i= k
4318  ENDIF
4319  IF (j <= i+1) EXIT
4320  ENDDO
4321  ENDIF
4322 *
4323  dx= u-x(i)
4324 *
4325 * evaluate the spline
4326 *
4327  IF (Present(f)) f= y(i)+dx*(b(i)+dx*(c(i)+dx*d(i)))
4328  IF (Present(fp)) fp= b(i)+dx*(two*c(i) + dx*three*d(i))
4329  IF (Present(fpp)) fpp= two*c(i) + dx*six*d(i)
4330  IF (Present(fppp)) fppp= six*d(i)
4331 *
4332  RETURN
4333 *
4334  END SUBROUTINE hto_seval3singleht
4335 *

◆ hto_gridlow()

subroutine hto_gridlow ( real*8  mass,
real*8  evalue 
)

Definition at line 4343 of file CALLING_cpHTO.f.

4343 *
4344  IMPLICIT NONE
4345 *
4346  INTEGER i,top,gdim
4347  real*8 u,value,evalue,mass
4348  real*8, dimension(22) :: bc,cc,dc
4349 *
4350 * u value of M_H at which the spline is to be evaluated
4351 * top= -1,0,1 lower, central, upper value for m_top
4352 *
4353  gdim= 22
4354 *
4355  CALL hto_fmmsplinesinglel(bc,cc,dc,top,gdim)
4356 *
4357  u= mass
4358  CALL hto_seval3singlel(u,bc,cc,dc,top,gdim,value)
4359 *
4360  evalue= value
4361 *
4362  RETURN
4363 *
4364 *-----------------------------------------------------------------------
4365 *
4366  CONTAINS
4367 *
4368  SUBROUTINE hto_fmmsplinesinglel(b,c,d,top,gdim)
4369 *
4370 *---------------------------------------------------------------------------
4371 *
4372  INTEGER k,n,i,top,gdim,l
4373 *
4374  real*8, dimension(22) :: xc,yc
4375  real*8, dimension(22) :: x,y
4376 *
4377  real*8, DIMENSION(gdim) :: b
4378 * linear coeff
4379 *
4380  real*8, DIMENSION(gdim) :: c
4381 * quadratic coeff.
4382 *
4383  real*8, DIMENSION(gdim) :: d
4384 * cubic coeff.
4385 *
4386  real*8 :: t
4387  real*8,PARAMETER:: zero=0.0, two=2.0, three=3.0
4388 *
4389 * The grid
4390 *
4391 *
4392  DATA (xc(i),i=1,22)/
4393  # 190.d0,191.d0,192.d0,193.d0,194.d0,195.d0,196.d0,197.d0,198.d0,
4394  # 199.d0,200.d0,240.d0,241.d0,242.d0,243.d0,244.d0,245.d0,246.d0,
4395  # 247.d0,248.d0,249.d0,250.d0/
4396 *
4397  DATA (yc(i),i=1,22)/
4398  # 0.10346d1,0.10750d1,0.11151d1,0.11549d1,0.11942d1,0.12329d1,
4399  # 0.12708d1,0.13083d1,0.13456d1,0.13832d1,0.14212d1,
4400  # 0.32401d1,0.32994d1,0.33593d1,0.34200d1,0.34813d1,0.35433d1,
4401  # 0.36061d1,0.36695d1,0.37336d1,0.37984d1,0.38640d1/
4402 *
4403  n= 22
4404  FORALL(l=1:22)
4405  x(l)= xc(l)
4406  y(l)= yc(l)
4407  ENDFORALL
4408 
4409 *.....Set up tridiagonal system.........................................
4410 * b=diagonal, d=offdiagonal, c=right-hand side
4411 *
4412  d(1)= x(2)-x(1)
4413  c(2)= (y(2)-y(1))/d(1)
4414  DO k= 2,n-1
4415  d(k)= x(k+1)-x(k)
4416  b(k)= two*(d(k-1)+d(k))
4417  c(k+1)= (y(k+1)-y(k))/d(k)
4418  c(k)= c(k+1)-c(k)
4419  END DO
4420 *
4421 *.....End conditions. third derivatives at x(1) and x(n) obtained
4422 * from divided differences.......................................
4423 *
4424  b(1)= -d(1)
4425  b(n)= -d(n-1)
4426  c(1)= zero
4427  c(n)= zero
4428  IF (n > 3) THEN
4429  c(1)= c(3)/(x(4)-x(2))-c(2)/(x(3)-x(1))
4430  c(n)= c(n-1)/(x(n)-x(n-2))-c(n-2)/(x(n-1)-x(n-3))
4431  c(1)= c(1)*d(1)*d(1)/(x(4)-x(1))
4432  c(n)= -c(n)*d(n-1)*d(n-1)/(x(n)-x(n-3))
4433  END IF
4434 *
4435  DO k=2,n ! forward elimination
4436  t= d(k-1)/b(k-1)
4437  b(k)= b(k)-t*d(k-1)
4438  c(k)= c(k)-t*c(k-1)
4439  END DO
4440 *
4441  c(n)= c(n)/b(n)
4442 *
4443 * back substitution ( makes c the sigma of text)
4444 *
4445  DO k=n-1,1,-1
4446  c(k)= (c(k)-d(k)*c(k+1))/b(k)
4447  END DO
4448 *
4449 *.....Compute polynnomial coefficients...................................
4450 *
4451  b(n)= (y(n)-y(n-1))/d(n-1)+d(n-1)*(c(n-1)+c(n)+c(n))
4452  DO k=1,n-1
4453  b(k)= (y(k+1)-y(k))/d(k)-d(k)*(c(k+1)+c(k)+c(k))
4454  d(k)= (c(k+1)-c(k))/d(k)
4455  c(k)= three*c(k)
4456  END DO
4457  c(n)= three*c(n)
4458  d(n)= d(n-1)
4459 *
4460  RETURN
4461 *
4462  END SUBROUTINE hto_fmmsplinesinglel
4463 *
4464 *------------------------------------------------------------------------
4465 *
4466  SUBROUTINE hto_seval3singlel(u,b,c,d,top,gdim,f,fp,fpp,fppp)
4467 *
4468 * ---------------------------------------------------------------------------
4469 *
4470  real*8,INTENT(IN) :: u
4471 * abscissa at which the spline is to be evaluated
4472 *
4473  INTEGER j,k,n,l,top,gdim
4474 *
4475  real*8, dimension(22) :: xc,yc
4476  real*8, dimension(22) :: x,y
4477  real*8, DIMENSION(gdim) :: b,c,d
4478 * linear,quadratic,cubic coeff
4479 *
4480  real*8,INTENT(OUT),OPTIONAL:: f,fp,fpp,fppp
4481 * function, 1st,2nd,3rd deriv
4482 *
4483  INTEGER, SAVE :: i=1
4484  real*8 :: dx
4485  real*8,PARAMETER:: two=2.0, three=3.0, six=6.0
4486 *
4487 * The grid
4488 *
4489  DATA (xc(l),l=1,22)/
4490  # 190.d0,191.d0,192.d0,193.d0,194.d0,195.d0,196.d0,197.d0,198.d0,
4491  # 199.d0,200.d0,240.d0,241.d0,242.d0,243.d0,244.d0,245.d0,246.d0,
4492  # 247.d0,248.d0,249.d0,250.d0/
4493 *
4494  DATA (yc(l),l=1,22)/
4495  # 0.10346d1,0.10750d1,0.11151d1,0.11549d1,0.11942d1,0.12329d1,
4496  # 0.12708d1,0.13083d1,0.13456d1,0.13832d1,0.14212d1,
4497  # 0.32401d1,0.32994d1,0.33593d1,0.34200d1,0.34813d1,0.35433d1,
4498  # 0.36061d1,0.36695d1,0.37336d1,0.37984d1,0.38640d1/
4499 *
4500  n= 22
4501  FORALL(l=1:22)
4502  x(l)= xc(l)
4503  y(l)= yc(l)
4504  ENDFORALL
4505 *
4506 *.....First check if u is in the same interval found on the
4507 * last call to Seval.............................................
4508 *
4509  IF ( (i<1) .OR. (i >= n) ) i=1
4510  IF ( (u < x(i)) .OR. (u >= x(i+1)) ) THEN
4511  i=1
4512 *
4513 * binary search
4514 *
4515  j= n+1
4516  DO
4517  k= (i+j)/2
4518  IF (u < x(k)) THEN
4519  j= k
4520  ELSE
4521  i= k
4522  ENDIF
4523  IF (j <= i+1) EXIT
4524  ENDDO
4525  ENDIF
4526 *
4527  dx= u-x(i)
4528 *
4529 * evaluate the spline
4530 *
4531  IF (Present(f)) f= y(i)+dx*(b(i)+dx*(c(i)+dx*d(i)))
4532  IF (Present(fp)) fp= b(i)+dx*(two*c(i) + dx*three*d(i))
4533  IF (Present(fpp)) fpp= two*c(i) + dx*six*d(i)
4534  IF (Present(fppp)) fppp= six*d(i)
4535 *
4536  RETURN
4537 *
4538  END SUBROUTINE hto_seval3singlel
4539 *

◆ hto_initalphas()

subroutine hto_initalphas ( integer  IORD,
real*8  FR2,
real*8  MUR,
real*8  ASMUR,
real*8  MC,
real*8  MB,
real*8  MT 
)

Definition at line 2089 of file CALLING_cpHTO.f.

2089  USE hto_dzpar
2090 *
2091 
2092 *-- IORD = 0 (LO), 1 (NLO), 2 (NNLO), 3 (NNNLO).
2093 *-- FR2 = ratio of mu_f^2 to mu_r^2 (must be a fixed value).
2094 *-- MUR = input renormalisation scale (in GeV) for alpha_s.
2095 *-- ASMUR = input value of alpha_s at the renormalisation scale MUR.
2096 *-- MC,MB,MT = heavy quark masses in GeV.
2097 *
2098  IMPLICIT NONE
2099 *
2100  INTEGER IORD
2101  real*8 fr2,mur,asmur,mc,mb,mt,a,b,hto_dzero,
2102  # hto_findalphasr0,r0,asi
2103  real*8, parameter :: eps=1.d-10
2104  INTEGER, parameter :: MAXF=10000
2105  INTEGER, parameter :: MODE=1
2106  EXTERNAL hto_findalphasr0
2107 
2108  IF(mur*sqrt(fr2).LE.mc) THEN ! Check that MUF <= MC.
2109  r0 = mur
2110  asi = asmur
2111  ELSE ! Solve for alpha_s at R0 = 1 GeV.
2112 *
2113 *-- Copy variables to common block.
2114 *
2115  r0c = 1.d0/sqrt(fr2)
2116  iordc = iord
2117  fr2c = fr2
2118  murc = mur
2119  asmurc = asmur
2120  mcc = mc
2121  mbc = mb
2122  mtc = mt
2123 *
2124 *-- Now get alpha_s(R0) corresponding to alpha_s(MUR).
2125 *
2126  a = 0.02d0 ! lower bound for alpha_s(R0)
2127  b = 2.00d0 ! upper bound for alpha_s(R0)
2128  r0 = r0c
2129  asi = hto_dzero(a,b,eps,maxf,hto_findalphasr0,mode)
2130  ENDIF
2131 
2132  CALL hto_initalphasr0(iord,fr2,r0,asi,mc,mb,mt)
2133 
2134  RETURN

◆ hto_initalphasr0()

subroutine hto_initalphasr0 ( integer  IORD,
real*8  FR2,
real*8  R0,
real*8  ASI,
real*8  MC,
real*8  MB,
real*8  MT 
)

Definition at line 2159 of file CALLING_cpHTO.f.

2159  USE hto_rzeta
2160  USE hto_colour
2161  USE hto_asinp
2162  USE hto_aspar
2163  USE hto_varflv
2164  USE hto_nffix
2165  USE hto_frrat
2166 *
2167 *-- IORD = 0 (LO), 1 (NLO), 2 (NNLO), 3 (NNNLO).
2168 *-- FR2 = ratio of mu_f^2 to mu_r^2 (must be a fixed value).
2169 *-- R0 = input renormalisation scale (in GeV) for alphas_s.
2170 *-- ASI = input value of alpha_s at the renormalisation scale R0.
2171 *-- MC,MB,MT = heavy quark masses in GeV.
2172 *-- Must have R0*sqrt(FR2) <= MC to call this subroutine.
2173 *
2174  IMPLICIT NONE
2175 *
2176  INTEGER IORD
2177  real*8 fr2,r0,asi,mc,mb,mt,r20,mc2,mb2,mt2
2178  real*8, parameter :: pi= 3.14159265358979d0
2179 *
2180 * ..QCD colour factors
2181 *
2182  ca = 3.d0
2183  cf = 4.d0/3.d0
2184  tr = 0.5 d0
2185 *
2186 * ..The lowest integer values of the Zeta function
2187 *
2188  zeta(1) = 0.5772 15664 90153 d0
2189  zeta(2) = 1.64493 40668 48226 d0
2190  zeta(3) = 1.20205 69031 59594 d0
2191  zeta(4) = 1.08232 32337 11138 d0
2192  zeta(5) = 1.03692 77551 43370 d0
2193  zeta(6) = 1.01734 30619 84449 d0
2194 
2195  ivfns = 1 ! variable flavour-number scheme (VFNS)
2196 C IVFNS = 0 ! fixed flavour-number scheme (FFNS)
2197  nff = 4 ! number of flavours for FFNS
2198  naord = iord ! perturbative order of alpha_s
2199  nastps = 20 ! num. steps in Runge-Kutta integration
2200  r20 = r0**2 ! input renormalisation scale
2201  mc2 = mc**2 ! mu_f^2 for charm threshold
2202  mb2 = mb**2 ! mu_f^2 for bottom threshold
2203  mt2 = mt**2 ! mu_f^2 for top threshold
2204  logfr = log(fr2) ! log of ratio of mu_f^2 to mu_r^2
2205  m20 = r20 * fr2 ! input factorisation scale
2206 
2207 *
2208 * ..Stop some nonsense
2209 *
2210  IF( (ivfns .EQ. 0) .AND. (nff .LT. 3) ) THEN
2211  print*, 'Wrong flavour number for FFNS evolution. STOP'
2212  stop
2213  ENDIF
2214  IF( (ivfns .EQ. 0) .AND. (nff .GT. 5) ) THEN
2215  print*, 'Wrong flavour number for FFNS evolution. STOP'
2216  stop
2217  ENDIF
2218 *
2219  IF( naord .GT. 3 ) THEN
2220  print*, 'Specified order in a_s too high. STOP'
2221  stop
2222  ENDIF
2223 *
2224  IF( (ivfns .NE. 0) .AND. (fr2 .GT. 4.001d0) ) THEN
2225  print*, 'Too low mu_r for VFNS evolution. STOP'
2226  stop
2227  ENDIF
2228 *
2229  IF( (ivfns .EQ. 1) .AND. (m20 .GT. mc2) ) THEN
2230  print*, 'Too high mu_0 for VFNS evolution. STOP'
2231  stop
2232  ENDIF
2233 *
2234  IF( (asi .GT. 2.d0) .OR. (asi .LT. 2.d-2) ) THEN
2235  print*, 'alpha_s out of range. STOP'
2236  stop
2237  ENDIF
2238 *
2239  IF( (ivfns .EQ. 1) .AND. (mc2 .GT. mb2) ) THEN
2240  print*, 'Wrong charm-bottom mass hierarchy. STOP'
2241  stop
2242  ENDIF
2243  IF( (ivfns .EQ. 1) .AND. (mb2 .GT. mt2) ) THEN
2244  print*, 'Wrong bottom-top mass hierarchy. STOP'
2245  stop
2246  ENDIF
2247 *
2248 *
2249 *-- Store the beta function coefficients in a COMMON block.
2250 *
2251  CALL hto_betafct
2252 *
2253 *-- Store a_s = alpha_s(mu_r^2)/(4 pi) at the input scale R0.
2254 *
2255  as0 = asi / (4.d0* pi)
2256 *
2257 *-- Store alpha_s at the heavy flavour thresholds in a COMMON block.
2258 *
2259  IF(ivfns .NE. 0) THEN
2260  CALL hto_evnfthr(mc2,mb2,mt2)
2261  ENDIF
2262 
2263  RETURN

◆ hto_lb021_dm_cp()

real*8 function, dimension(2) hto_lb021_dm_cp ( real*8  scal,
real*8, dimension(2)  psi,
real*8  ps0i,
real*8, dimension(2,2), intent(in)  xmsi,
real*8, dimension(2), intent(in)  xm0i 
)

Definition at line 7591 of file CALLING_cpHTO.f.

7591  USE hto_cmplx_root
7592  USE hto_cmplx_rootz
7593  USE hto_cmplx_srs_root
7594  USE hto_ln_2_riemann
7595  USE hto_acmplx_pro
7596  USE hto_acmplx_rat
7597  USE hto_full_ln
7598  USE hto_units
7599 *
7600  IMPLICIT NONE
7601 *
7602  INTEGER i,nci,nc
7603  real*8 scal,scals,ps0i,ps0,xm1,xm2
7604  real*8, intent(in), dimension(2) :: xm0i
7605  real*8, intent(in), dimension(2,2) :: xmsi
7606  real*8, dimension(2) :: value,xm1c,xm2c
7607  real*8, dimension(2,2) :: xms
7608  real*8, dimension(2) :: xm0
7609  real*8, dimension(2) :: psi,ps,aroot,root,lambdasc,lambdas,
7610  # lambdac,lambda,argc,arg,llam,l1,l2
7611 *
7612  ps= psi
7613  ps0= ps0i
7614  xms= xmsi
7615  xm0= xm0i
7616 *
7617  xm1c(1:2)= xms(1,1:2)
7618  xm2c(1:2)= xms(2,1:2)
7619  xm1c= xm1c.cq.ps
7620  xm2c= xm2c.cq.ps
7621  xm1= xm0(1)*xm0(1)/ps0
7622  xm2= xm0(2)*xm0(2)/ps0
7623 *
7624  aroot= xm1c.cp.xm2c
7625  root= (aroot(1).crz.aroot(2))
7626 *
7627  lambdasc= co+(xm1c.cp.xm1c)+(xm2c.cp.xm2c)-2.d0*(
7628  # xm1c+xm2c+(xm1c.cp.xm2c))
7629  lambdas(1)= 1.d0+xm1*xm1+xm2*xm2-2.d0*(
7630  # xm1+xm2+xm1*xm2)
7631  lambdas(2)= -eps
7632  lambdac= (lambdasc(1)).crz.(lambdasc(2))
7633  lambda= (lambdas(1)).cr.(lambdas(2))
7634  IF(lambda(2).eq.0.d0) lambda(2)= -eps
7635 *
7636  argc= 0.5d0*((-co+xm1c+xm2c-lambdac).cq.root)
7637 *
7638  arg(1)= 0.5d0*(-1.d0+xm1+xm2-lambda(1))/sqrt(xm1*xm2)
7639  arg(2)= eps
7640 *
7641  llam= argc.lnsrs.arg
7642 *
7643  l1= xm1c(1).fln.xm1c(2)
7644  l2= xm2c(1).fln.xm2c(2)
7645 *
7646  value= (((xm1c-xm2c-co).cq.lambdac).cp.llam)+0.5d0*(l1-l2)
7647 *
7648  RETURN
7649 *

◆ hto_lb0af_dm()

real*8 function, dimension(2) hto_lb0af_dm ( real*8  scal,
real*8, dimension(2)  psi,
real*8  ps0i,
real*8, dimension(2,2)  xmsi,
real*8, dimension(2)  xm0i 
)

Definition at line 7483 of file CALLING_cpHTO.f.

7483  USE hto_acmplx_pro
7484  USE hto_acmplx_rat
7485  USE hto_cmplx_root
7486  USE hto_cmplx_rootz
7487  USE hto_cmplx_srs_root
7488  USE hto_ln_2_riemann
7489  USE hto_full_ln
7490  USE hto_units
7491 *
7492  IMPLICIT NONE
7493 *
7494  real*8 scal,ps0i,scals,ps0,xm1,xm2
7495  real*8, dimension(2,2) :: xmsi,xms
7496  real*8, dimension(2) :: value,psi,ps,lambdasc,lambdas,
7497  # lambdac,lambda,argc,arg,llam,lm,xm0,xm0i,aroot,
7498  # root,rat,lnr,xm1c,xm2c
7499 *
7500  scals= scal*scal
7501  ps= psi/scals
7502  ps0= ps0i/scals
7503  xms= xmsi/scals
7504  xm0= xm0i/scal
7505  xm1c(1:2)= xms(1,1:2)
7506  xm2c(1:2)= xms(2,1:2)
7507  xm1= xm0(1)*xm0(1)
7508  xm2= xm0(2)*xm0(2)
7509  aroot= xm1c.cp.xm2c
7510  root= (aroot(1).crz.aroot(2))
7511 *
7512  lambdasc= (ps.cp.ps)+(xm1c.cp.xm1c)+(xm2c.cp.xm2c)-2.d0*(
7513  # (ps.cp.xm1c)+(ps.cp.xm2c)+(xm1c.cp.xm2c))
7514  lambdas(1)= ps0*ps0+xm1*xm1+xm2*xm2-2.d0*(
7515  # ps0*xm1+ps0*xm2+xm1*xm2)
7516  lambdas(2)= -eps
7517  lambdac= (lambdasc(1)).crz.(lambdasc(2))
7518  lambda= (lambdas(1)).cr.(lambdas(2))
7519  IF(lambda(2).eq.0.d0) lambda(2)= -eps
7520 *
7521  argc= 0.5d0*((-ps+xm1c+xm2c-lambdac).cq.root)
7522 *
7523  arg(1)= 0.5d0*(-ps0+xm1+xm2-lambda(1))/sqrt(xm1*xm2)
7524  arg(2)= eps
7525 *
7526  llam= argc.lnsrs.arg
7527 *
7528  rat= xm1c.cq.xm2c
7529  lnr= rat(1).fln.rat(2)
7530 *
7531  value= 2.d0*co-0.5d0*(((xm1c-xm2c).cq.ps).cp.lnr)-
7532  # ((lambdac.cq.ps).cp.llam)
7533 *
7534  RETURN
7535 *

◆ hto_lb0af_em()

real*8 function, dimension(2) hto_lb0af_em ( real*8  scal,
real*8, dimension(2)  psi,
real*8  ps0i,
real*8, dimension(2)  xmsi,
real*8  xm0i 
)

Definition at line 7541 of file CALLING_cpHTO.f.

7541  USE hto_acmplx_pro
7542  USE hto_acmplx_rat
7543  USE hto_cmplx_root
7544  USE hto_cmplx_rootz
7545  USE hto_cmplx_srs_root
7546  USE hto_ln_2_riemann
7547  USE hto_full_ln
7548  USE hto_units
7549 *
7550  IMPLICIT NONE
7551 *
7552  real*8 scal,ps0i,xm0i,scals,ps0,xm0
7553  real*8, dimension(2) :: value,psi,ps,xmsi,xms,betasc,betas,
7554  # betac,beta,argc,arg,lbet
7555 *
7556  scals= scal*scal
7557  ps= psi/scals
7558  ps0= ps0i/scals
7559  xms= xmsi/scals
7560  xm0= xm0i/scal
7561 *
7562  betasc= co-4.d0*(xms.cq.ps)
7563  IF(betasc(2).eq.0.d0) THEN
7564  betasc(2)= -eps
7565  betac= (betasc(1)).cr.(betasc(2))
7566  ELSE
7567  betac= (betasc(1)).crz.(betasc(2))
7568  ENDIF
7569  argc= (betac+co).cq.(betac-co)
7570  IF(argc(2).eq.0.d0) THEN
7571  argc(2)= eps
7572  lbet= argc(1).fln.argc(2)
7573  ELSE
7574  betas(1)= 1.d0-4.d0*(xm0*xm0)/ps0
7575  betas(2)= -eps
7576  beta= (betas(1)).cr.(betas(2))
7577  arg= (beta+co).cq.(beta-co)
7578  IF(arg(2).eq.0.d0) arg(2)= eps
7579  lbet= argc.lnsrs.arg
7580  ENDIF
7581 *
7582  value= 2.d0*co-(betac.cp.lbet)
7583 *
7584  RETURN
7585 *

◆ hto_lquarkqcd()

real*8 function, dimension(2) hto_lquarkqcd ( real*8  scal,
real*8, dimension(2)  psi,
real*8  ps0i,
real*8, dimension(2)  xmsi,
real*8  xm0i,
integer  type 
)

Definition at line 7307 of file CALLING_cpHTO.f.

7307  USE hto_riemann
7308  USE hto_acmplx_pro
7309  USE hto_acmplx_rat
7310  USE hto_cmplx_root
7311  USE hto_cmplx_rootz
7312  USE hto_cmplx_srs_root
7313  USE hto_ln_2_riemann
7314  USE hto_full_ln
7315  USE hto_sp_fun
7316  USE hto_units
7317 *
7318  IMPLICIT NONE
7319 *
7320  INTEGER it,type,unit
7321  real*8 scal,ps0i,xm0i,scals,ps0,xm0,sgn
7322  real*8, dimension(2) :: value,psi,ps,xmsi,xms,betasc,betas,
7323  # betac,beta,argc,arg,lq,lm,cx,comx,cxs,x,omx,xs,clx,clomx,
7324  # clxs,li2cx,li3cx,li2cxs,li3cxs,copx,clopx,lqs,qcd,lms,
7325  # opx,tau,taus,clxx,clxxs
7326  real*8, dimension(6,2) :: aux,auxs
7327 *
7328  scals= scal*scal
7329  ps= psi/scals
7330  ps0= ps0i/scals
7331  xms= xmsi/scals
7332  xm0= xm0i/scal
7333 *
7334  IF(psi(2).eq.0.d0.and.xmsi(2).eq.0.d0.
7335  # and.psi(1).le.4.d0*xmsi(1)) THEN
7336  unit= 1
7337  ELSE
7338  unit= 0
7339  ENDIF
7340 *
7341  IF(abs(ps(2)/ps(1)).lt.1.d-10.and.xms(2).eq.0.d0) THEN
7342  betasc(1)= 1.d0-4.d0*xms(1)/ps(1)
7343  betasc(2)= 4.d0/(ps(1)*ps(1))*xms(1)*ps(2)
7344  ELSE
7345  betasc= co-4.d0*(xms.cq.ps)
7346  ENDIF
7347  IF(betasc(2).eq.0.d0) THEN
7348  betasc(2)= -eps
7349  betac= (betasc(1)).cr.(betasc(2))
7350  ELSE
7351  betac= (betasc(1)).crz.(betasc(2))
7352  ENDIF
7353  argc= (betac+co).cq.(betac-co)
7354 *
7355  betas(1)= 1.d0-4.d0*xm0*xm0/ps0
7356  betas(2)= -eps
7357  beta= (betas(1)).cr.(betas(2))
7358  arg= (beta+co).cq.(beta-co)
7359 *
7360  IF(arg(2).eq.0.d0) THEN
7361  x(1)= 1.d0/arg(1)
7362  x(2)= -eps
7363  sgn= sign(one,x(1))
7364  xs(1)= x(1)*x(1)
7365  xs(2)= -sgn*eps
7366  ELSE
7367  x= (beta-co).cq.(beta+co)
7368  xs= x.cp.x
7369  ENDIF
7370  omx= co-x
7371  opx= co+x
7372 *
7373  IF(arg(2).eq.0.d0) arg(2)= eps
7374  IF(argc(2).eq.0.d0) THEN
7375  it= 0
7376  argc(2)= eps
7377  lq= argc(1).fln.argc(2)
7378  ELSE
7379  it= 1
7380  lq= argc.lnsrs.arg
7381  ENDIF
7382  lqs= lq.cp.lq
7383 *
7384  IF(it.eq.0.d0) THEN
7385  cx(1)= 1.d0/argc(1)
7386  cx(2)= -eps
7387  comx= co-cx
7388  copx= co+cx
7389  sgn= sign(one,cx(1))
7390  cxs(1)= cx(1)*cx(1)
7391  cxs(2)= -sgn*eps
7392  clx= cx(1).fln.cx(2)
7393  clxs= clx.cp.clx
7394  clxx= cxs(1).fln.cxs(2)
7395  clxxs= clxx.cp.clxx
7396  clomx= comx(1).fln.comx(2)
7397  clopx= copx(1).fln.copx(2)
7398  aux= hto_s_niels_up4(cx)
7399  li2cx(1:2)= aux(1,1:2)
7400  li3cx(1:2)= aux(2,1:2)
7401  auxs= hto_s_niels_up4(cxs)
7402  li2cxs(1:2)= auxs(1,1:2)
7403  li3cxs(1:2)= auxs(2,1:2)
7404  ELSEIF(it.eq.1.d0) THEN
7405  cx= (betac-co).cq.(betac+co)
7406  comx= co-cx
7407  copx= co+cx
7408  cxs= cx.cp.cx
7409  clx= cx.lnsrs.x
7410  clxs= clx.cp.clx
7411  clxx= cxs.lnsrs.xs
7412  clxxs= clxx.cp.clxx
7413  clomx= comx.lnsrs.omx
7414  clopx= copx.lnsrs.opx
7415  li2cx= hto_li2_srsz(cx,x,unit)
7416  li3cx= hto_li3_srsz(cx,x,unit)
7417  li2cxs= hto_li2_srsz(cxs,xs,unit)
7418  li3cxs= hto_li3_srsz(cxs,xs,unit)
7419  ENDIF
7420 *
7421  IF(xms(2).eq.0.d0) THEN
7422  lm(1)= log(xms(1))
7423  lm(2)= 0.d0
7424  ELSE
7425  lm= xms(1).fln.xms(2)
7426  ENDIF
7427  lms= lm.cp.lm
7428 *
7429  tau= xms.cq.ps
7430  taus= tau.cp.tau
7431 *
7432  IF(type.eq.0) THEN
7433 *
7434  qcd= -3.d0/4.d0*(co-12.d0*tau)*rz2
7435  # +1.d0/16.d0*(3.d0*co+344.d0*tau)
7436  # -3.d0/2.d0*((co-6.d0*tau).cp.lms)
7437  # +3.d0/4.d0*((3.d0*co-14.d0*tau).cp.(betac.cp.clx))
7438  # -3.d0*((li3cxs-2.d0*li3cx+4.d0/3.d0*(li2cx.cp.clx)
7439  # +1.d0/3.d0*(clxs.cp.clomx)+rz3*co
7440  # -2.d0/3.d0*(clxx.cp.li2cxs)-1.d0/6.d0*(clxxs.cp.clomx)
7441  # -1.d0/6.d0*
7442  # (clxxs.cp.clopx)).cp.((co-4.d0*tau).cp.(co-2.d0*tau)))
7443  # -1.d0/2.d0*((4.d0*li2cxs-4.d0*li2cx-4.d0*(clomx.cp.clx)
7444  # -2.d0*(cx.cp.(clxs.cq.comx))+4.d0*(clxx.cp.clomx)
7445  # +4.d0*(clxx.cp.clopx)+(clxxs.cp.(cxs.cq.comx))
7446  # +(clxxs.cp.(cxs.cq.copx))).cp.(betac.cp.(co-4.d0*tau)))
7447  # +1.d0/4.d0*(lm.cp.(11.d0*co-108.d0*tau))
7448  # +1.d0/4.d0*(clxs.cp.(3.d0*co+58.d0*taus-28.d0*tau))
7449 *
7450  ELSEIF(type.eq.1) THEN
7451 *
7452  qcd= -3.d0/4.d0*(co-12.d0*tau)*rz2
7453  # +1.d0/16.d0*(67.d0*co-40.d0*tau)
7454  # +3.d0/4.d0*((3.d0*co-14.d0*tau).cp.(betac.cp.clx))
7455  # -3.d0*((li3cxs-2.d0*li3cx+4.d0/3.d0*(li2cx.cp.clx)
7456  # +1.d0/3.d0*(clxs.cp.clomx)+rz3*co
7457  # -2.d0/3.d0*(clxx.cp.li2cxs)-1.d0/6.d0*(clxxs.cp.clomx)
7458  # -1.d0/6.d0*
7459  # (clxxs.cp.clopx)).cp.((co-4.d0*tau).cp.(co-2.d0*tau)))
7460  # -1.d0/2.d0*((4.d0*li2cxs-4.d0*li2cx-4.d0*(clomx.cp.clx)
7461  # -2.d0*(cx.cp.(clxs.cq.comx))+4.d0*(clxx.cp.clomx)
7462  # +4.d0*(clxx.cp.clopx)+(clxxs.cp.(cxs.cq.comx))
7463  # +(clxxs.cp.(cxs.cq.copx))).cp.(betac.cp.(co-4.d0*tau)))
7464  # -2.d0*
7465  # (((co-8.d0*tau).cp.(betac.cp.lq)).cp.(co-3.d0/4.d0*lm))
7466  # -3.d0*((betac.cp.lq).cp.(lm.cp.tau))
7467  # +4.d0*((co.cp.betac).cp.(lq.cp.tau))
7468  # -9.d0/4.d0*(lm.cp.(co+4.d0*tau))
7469  # +9.d0*(lms.cp.tau)
7470  # +1.d0/4.d0*(clxs.cp.(3.d0*co+58.d0*taus-28.d0*tau))
7471 *
7472  ENDIF
7473 *
7474  value= qcd
7475 *
7476  RETURN
7477 *

◆ hto_pole()

subroutine hto_pole ( real*8  m,
real*8  mhb,
real*8  ghb 
)

Definition at line 5038 of file CALLING_cpHTO.f.

5038  USE hto_masses
5039  USE hto_riemann
5040  USE hto_sp_fun
5041  USE hto_aux_hcp
5042 *
5043  IMPLICIT NONE
5044 *
5045  INTEGER i
5046  real*8 muh,cpgh,gos,mhb,ghb,m,sclaec,expghi,ewc,ghi
5047  real*8, dimension(10,2) :: expc
5048 *
5049  INTERFACE
5050  FUNCTION hto_deriv(scal,rhm) RESULT(value)
5051  USE hto_masses
5052  USE hto_acmplx_pro
5053  USE hto_acmplx_rat
5054  USE hto_cmplx_root
5055  USE hto_full_ln
5056  USE hto_qcd
5057  USE hto_units
5058  IMPLICIT NONE
5059  real*8 scal,rhm
5060  real*8, dimension(10,2) :: value
5061  END FUNCTION hto_deriv
5062  END INTERFACE
5063 *
5064  CALL hto_init_niels
5065 *
5066  muh= m
5067 *
5068  CALL hto_gridht(muh,gos)
5069 *
5070  IF(muh.le.200.d0) THEN
5071  expc= hto_deriv(muh,muh)
5072  ewc= 4.d0*sqrt(2.d0)*1.16637d-5*(mw*mw)/pis
5073  expghi= gos
5074  # -ewc*ewc*expc(2,2)*expc(2,2)*gos
5075  # +0.5d0*ewc*(expc(2,2)/muh-expc(5,2)*muh)*gos*gos
5076  cpgh= expghi
5077  ELSEIF((muh > 200.d0).and.(muh < 240.d0)) THEN
5078  CALL hto_gridlow(muh,ghi)
5079  cpgh= ghi
5080  ELSE
5081  CALL hto_gh(muh,cpgh)
5082  ENDIF
5083 *
5084  mhb= sqrt(muh*muh+cpgh*cpgh)
5085  ghb= mhb/muh*cpgh
5086 *
5087  RETURN
5088 *

◆ hto_poles()

subroutine hto_poles ( real*8  m,
integer  nv 
)

Definition at line 6714 of file CALLING_cpHTO.f.

6714  USE hto_transfmh
6715  USE hto_masses
6716  USE hto_set_phys_const
6717  USE hto_solve_nonlin
6718 *
6719  IMPLICIT NONE
6720 *
6721  INTEGER nv,n,info
6722  real*8 m,tol
6723  real*8, dimension(3) :: xcp,fvcp,diag
6724  EXTERNAL hto_cpoles
6725 *
6726  n= nv
6727  tol= 1.d-8
6728  tmuh= m
6729  xcp(1)= sqrt(20.d0/mw)
6730  xcp(2)= 1.d0
6731  xcp(3)= 1.d0
6732  CALL hto_hbrd(hto_cpoles,n,xcp,fvcp,tol,tol,info,diag)
6733  print 2003,info
6734  print*,' '
6735  IF(info == 1) THEN
6736  print*,'ALGORITHM ESTIMATES THAT THE RELATIVE ERROR'
6737  print*,'BETWEEN X AND THE SOLUTION IS AT MOST TOL'
6738  ELSEIF(info == 2) THEN
6739  print*,'NUMBER OF CALLS TO FCN HAS REACHED'
6740  print*,'OR EXCEEDED 200*(N+1)'
6741  ELSEIF(info == 3) THEN
6742  print*,'TOL IS TOO SMALL. NO FURTHER IMPROVEMENT IN'
6743  print*,'THE APPROXIMATE SOLUTION X IS POSSIBLE'
6744  ELSEIF(info == 4) THEN
6745  print*,'ITERATION IS NOT MAKING GOOD PROGRESS'
6746  ENDIF
6747  print*,' '
6748  print 2005,1.d-2*xcp(2)*xcp(2)*m
6749  print 2004,1.d-1*xcp(1)*xcp(1)*mw,
6750  # imw*(1.d0-0.5d0*(imw*imw)/(mw*mw))
6751  IF(n == 3) THEN
6752  print 2006,1.d-2*xcp(3)*xcp(3)*mt,imt
6753  ENDIF
6754 *
6755  2003 format(' info =',i2)
6756 *
6757  2004 format(' gammaW = ',2e20.5)
6758  2005 format(' gammaH = ',e20.5)
6759  2006 format(' gammat = ',2e20.5)
6760 *
6761  RETURN
6762 *

◆ hto_quarkqcd()

real*8 function, dimension(2) hto_quarkqcd ( real*8  scal,
real*8, dimension(2)  psi,
real*8  ps0i,
real*8, dimension(2)  xmsi,
real*8  xm0i,
integer  type 
)

Definition at line 2851 of file CALLING_cpHTO.f.

2851  USE hto_riemann
2852  USE hto_acmplx_pro
2853  USE hto_acmplx_rat
2854  USE hto_cmplx_root
2855  USE hto_cmplx_rootz
2856  USE hto_cmplx_srs_root
2857  USE hto_ln_2_riemann
2858  USE hto_full_ln
2859  USE hto_sp_fun
2860  USE hto_units
2861 *
2862  IMPLICIT NONE
2863 *
2864  INTEGER it,type,unit
2865  real*8 scal,ps0i,xm0i,scals,ps0,xm0,sgn
2866  real*8, dimension(2) :: value,psi,ps,xmsi,xms,betasc,betas,
2867  # betac,beta,argc,arg,lq,lm,cx,comx,cxs,x,omx,xs,clx,clomx,
2868  # clxs,li2cx,li3cx,li2cxs,li3cxs,copx,clopx,lqs,qcd,lms,
2869  # opx,tau,taus,clxx,clxxs
2870  real*8, dimension(6,2) :: aux,auxs
2871 *
2872  scals= scal*scal
2873  ps= psi/scals
2874  ps0= ps0i/scals
2875  xms= xmsi/scals
2876  xm0= xm0i/scal
2877 *
2878  IF(psi(2).eq.0.d0.and.xmsi(2).eq.0.d0.
2879  # and.psi(1).le.4.d0*xmsi(1)) THEN
2880  unit= 1
2881  ELSE
2882  unit= 0
2883  ENDIF
2884 *
2885  IF(abs(ps(2)/ps(1)).lt.1.d-10.and.xms(2).eq.0.d0) THEN
2886  betasc(1)= 1.d0-4.d0*xms(1)/ps(1)
2887  betasc(2)= 4.d0/(ps(1)*ps(1))*xms(1)*ps(2)
2888  ELSE
2889  betasc= co-4.d0*(xms.cq.ps)
2890  ENDIF
2891  IF(betasc(2).eq.0.d0) THEN
2892  betasc(2)= -eps
2893  betac= (betasc(1)).cr.(betasc(2))
2894  ELSE
2895  betac= (betasc(1)).crz.(betasc(2))
2896  ENDIF
2897  argc= (betac+co).cq.(betac-co)
2898 *
2899  betas(1)= 1.d0-4.d0*xm0*xm0/ps0
2900  betas(2)= -eps
2901  beta= (betas(1)).cr.(betas(2))
2902  arg= (beta+co).cq.(beta-co)
2903 *
2904  IF(arg(2).eq.0.d0) THEN
2905  x(1)= 1.d0/arg(1)
2906  x(2)= -eps
2907  sgn= sign(one,x(1))
2908  xs(1)= x(1)*x(1)
2909  xs(2)= -sgn*eps
2910  ELSE
2911  x= (beta-co).cq.(beta+co)
2912  xs= x.cp.x
2913  ENDIF
2914  omx= co-x
2915  opx= co+x
2916 *
2917  IF(arg(2).eq.0.d0) arg(2)= eps
2918  IF(argc(2).eq.0.d0) THEN
2919  it= 0
2920  argc(2)= eps
2921  lq= argc(1).fln.argc(2)
2922  ELSE
2923  it= 1
2924  lq= argc.lnsrs.arg
2925  ENDIF
2926  lqs= lq.cp.lq
2927 *
2928  IF(it.eq.0.d0) THEN
2929  cx(1)= 1.d0/argc(1)
2930  cx(2)= -eps
2931  comx= co-cx
2932  copx= co+cx
2933  sgn= sign(one,cx(1))
2934  cxs(1)= cx(1)*cx(1)
2935  cxs(2)= -sgn*eps
2936  clx= cx(1).fln.cx(2)
2937  clxs= clx.cp.clx
2938  clxx= cxs(1).fln.cxs(2)
2939  clxxs= clxx.cp.clxx
2940  clomx= comx(1).fln.comx(2)
2941  clopx= copx(1).fln.copx(2)
2942  aux= hto_s_niels_up4(cx)
2943  li2cx(1:2)= aux(1,1:2)
2944  li3cx(1:2)= aux(2,1:2)
2945  auxs= hto_s_niels_up4(cxs)
2946  li2cxs(1:2)= auxs(1,1:2)
2947  li3cxs(1:2)= auxs(2,1:2)
2948  ELSEIF(it.eq.1.d0) THEN
2949  cx= (betac-co).cq.(betac+co)
2950  comx= co-cx
2951  copx= co+cx
2952  cxs= cx.cp.cx
2953  clx= cx.lnsrs.x
2954  clxs= clx.cp.clx
2955  clxx= cxs.lnsrs.xs
2956  clxxs= clxx.cp.clxx
2957  clomx= comx.lnsrs.omx
2958  clopx= copx.lnsrs.opx
2959  li2cx= hto_li2_srsz(cx,x,unit)
2960  li3cx= hto_li3_srsz(cx,x,unit)
2961  li2cxs= hto_li2_srsz(cxs,xs,unit)
2962  li3cxs= hto_li3_srsz(cxs,xs,unit)
2963  ENDIF
2964 *
2965  IF(xms(2).eq.0.d0) THEN
2966  lm(1)= log(xms(1))
2967  lm(2)= 0.d0
2968  ELSE
2969  lm= xms(1).fln.xms(2)
2970  ENDIF
2971  lms= lm.cp.lm
2972 *
2973  tau= xms.cq.ps
2974  taus= tau.cp.tau
2975 *
2976  IF(type.eq.0) THEN
2977 *
2978  qcd= -3.d0/4.d0*(co-12.d0*tau)*rz2
2979  # +1.d0/16.d0*(3.d0*co+344.d0*tau)
2980  # -3.d0/2.d0*((co-6.d0*tau).cp.lms)
2981  # +3.d0/4.d0*((3.d0*co-14.d0*tau).cp.(betac.cp.clx))
2982  # -3.d0*((li3cxs-2.d0*li3cx+4.d0/3.d0*(li2cx.cp.clx)
2983  # +1.d0/3.d0*(clxs.cp.clomx)+rz3*co
2984  # -2.d0/3.d0*(clxx.cp.li2cxs)-1.d0/6.d0*(clxxs.cp.clomx)
2985  # -1.d0/6.d0*
2986  # (clxxs.cp.clopx)).cp.((co-4.d0*tau).cp.(co-2.d0*tau)))
2987  # -1.d0/2.d0*((4.d0*li2cxs-4.d0*li2cx-4.d0*(clomx.cp.clx)
2988  # -2.d0*(cx.cp.(clxs.cq.comx))+4.d0*(clxx.cp.clomx)
2989  # +4.d0*(clxx.cp.clopx)+(clxxs.cp.(cxs.cq.comx))
2990  # +(clxxs.cp.(cxs.cq.copx))).cp.(betac.cp.(co-4.d0*tau)))
2991  # +1.d0/4.d0*(lm.cp.(11.d0*co-108.d0*tau))
2992  # +1.d0/4.d0*(clxs.cp.(3.d0*co+58.d0*taus-28.d0*tau))
2993 *
2994  ELSEIF(type.eq.1) THEN
2995 *
2996  qcd= -3.d0/4.d0*(co-12.d0*tau)*rz2
2997  # +1.d0/16.d0*(67.d0*co-40.d0*tau)
2998  # +3.d0/4.d0*((3.d0*co-14.d0*tau).cp.(betac.cp.clx))
2999  # -3.d0*((li3cxs-2.d0*li3cx+4.d0/3.d0*(li2cx.cp.clx)
3000  # +1.d0/3.d0*(clxs.cp.clomx)+rz3*co
3001  # -2.d0/3.d0*(clxx.cp.li2cxs)-1.d0/6.d0*(clxxs.cp.clomx)
3002  # -1.d0/6.d0*
3003  # (clxxs.cp.clopx)).cp.((co-4.d0*tau).cp.(co-2.d0*tau)))
3004  # -1.d0/2.d0*((4.d0*li2cxs-4.d0*li2cx-4.d0*(clomx.cp.clx)
3005  # -2.d0*(cx.cp.(clxs.cq.comx))+4.d0*(clxx.cp.clomx)
3006  # +4.d0*(clxx.cp.clopx)+(clxxs.cp.(cxs.cq.comx))
3007  # +(clxxs.cp.(cxs.cq.copx))).cp.(betac.cp.(co-4.d0*tau)))
3008  # -2.d0*
3009  # (((co-8.d0*tau).cp.(betac.cp.lq)).cp.(co-3.d0/4.d0*lm))
3010  # -3.d0*((betac.cp.lq).cp.(lm.cp.tau))
3011  # +4.d0*((co.cp.betac).cp.(lq.cp.tau))
3012  # -9.d0/4.d0*(lm.cp.(co+4.d0*tau))
3013  # +9.d0*(lms.cp.tau)
3014  # +1.d0/4.d0*(clxs.cp.(3.d0*co+58.d0*taus-28.d0*tau))
3015 *
3016  ENDIF
3017 *
3018  value= qcd
3019 *
3020  RETURN
3021 *

◆ hto_seval3singleht()

subroutine hto_gridht::hto_seval3singleht ( real*8, intent(in)  u,
real*8, dimension(gdim)  b,
real*8, dimension(gdim)  c,
real*8, dimension(gdim)  d,
integer  top,
integer  gdim,
real*8, intent(out), optional  f,
real*8, intent(out), optional  fp,
real*8, intent(out), optional  fpp,
real*8, intent(out), optional  fppp 
)

Definition at line 4246 of file CALLING_cpHTO.f.

4246 *
4247 * ---------------------------------------------------------------------------
4248 *
4249  real*8,INTENT(IN) :: u
4250 * abscissa at which the spline is to be evaluated
4251 *
4252  INTEGER j,k,n,l,top,gdim
4253 *
4254  real*8, dimension(103) :: xc,yc
4255  real*8, dimension(103) :: x,y
4256  real*8, DIMENSION(gdim) :: b,c,d
4257 * linear,quadratic,cubic coeff
4258 *
4259  real*8,INTENT(OUT),OPTIONAL:: f,fp,fpp,fppp
4260 * function, 1st,2nd,3rd deriv
4261 *
4262  INTEGER, SAVE :: i=1
4263  real*8 :: dx
4264  real*8,PARAMETER:: two=2.0, three=3.0, six=6.0
4265 *
4266 * The grid
4267 *
4268  DATA (xc(l),l=1,103)/
4269  # 90.d0,95.d0,100.d0,105.d0,110.d0,115.d0,120.d0,
4270  # 125.d0,130.d0,135.d0,140.d0,145.d0,150.d0,155.d0,160.d0,165.d0,
4271  # 170.d0,175.d0,180.d0,185.d0,190.d0,195.d0,200.d0,210.d0,220.d0,
4272  # 230.d0,240.d0,250.d0,260.d0,270.d0,280.d0,290.d0,300.d0,310.d0,
4273  # 320.d0,330.d0,340.d0,350.d0,360.d0,370.d0,380.d0,390.d0,400.d0,
4274  # 410.d0,420.d0,430.d0,440.d0,450.d0,460.d0,470.d0,480.d0,490.d0,
4275  # 500.d0,510.d0,520.d0,530.d0,540.d0,550.d0,560.d0,570.d0,580.d0,
4276  # 590.d0,600.d0,610.d0,620.d0,630.d0,640.d0,650.d0,660.d0,670.d0,
4277  # 680.d0,690.d0,700.d0,710.d0,720.d0,730.d0,740.d0,750.d0,760.d0,
4278  # 770.d0,780.d0,790.d0,800.d0,810.d0,820.d0,830.d0,840.d0,850.d0,
4279  # 860.d0,870.d0,880.d0,890.d0,900.d0,910.d0,920.d0,930.d0,940.d0,
4280  # 950.d0,960.d0,970.d0,980.d0,990.d0,1000.d0/
4281 *
4282  DATA (yc(l),l=1,103)/
4283  # 2.20d-3,2.32d-3,2.46d-3,2.62d-3,2.82d-3,3.09d-3,3.47d-3,4.03d-3,
4284  # 4.87d-3,6.14d-3,8.12d-3,1.14d-2,1.73d-2,3.02d-2,8.29d-2,2.46d-1,
4285  # 3.80d-1,5.00d-1,6.31d-1,8.32d-1,1.04d0,1.24d0,1.43d0,1.85d0,
4286  # 2.31d0,2.82d0,3.40d0,4.04d0,4.76d0,5.55d0,6.43d0,7.39d0,8.43d0,
4287  # 9.57d0,10.8d0,12.1d0,13.5d0,15.2d0,17.6d0,20.2d0,23.1d0,26.1d0,
4288  # 29.2d0,32.5d0,35.9d0,39.4d0,43.1d0,46.9d0,50.8d0,54.9d0,59.1d0,
4289  # 63.5d0,68.0d0,72.7d0,77.6d0,82.6d0,87.7d0,93.1d0,98.7d0,104.d0,
4290  # 110.d0,116.d0,123.d0,129.d0,136.d0,143.d0,150.d0,158.d0,166.d0,
4291  # 174.d0,182.d0,190.d0,199.d0,208.d0,218.d0,227.d0,237.d0,248.d0,
4292  # 258.d0,269.d0,281.d0,292.d0,304.d0,317.d0,330.d0,343.d0,357.d0,
4293  # 371.d0,386.d0,401.d0,416.d0,432.d0,449.d0,466.d0,484.d0,502.d0,
4294  # 521.d0,540.d0,560.d0,581.d0,602.d0,624.d0,647.d0/
4295 *
4296  n= 103
4297  FORALL(l=1:103)
4298  x(l)= xc(l)
4299  y(l)= yc(l)
4300  ENDFORALL
4301 *
4302 *.....First check if u is in the same interval found on the
4303 * last call to Seval.............................................
4304 *
4305  IF ( (i<1) .OR. (i >= n) ) i=1
4306  IF ( (u < x(i)) .OR. (u >= x(i+1)) ) THEN
4307  i=1
4308 *
4309 * binary search
4310 *
4311  j= n+1
4312  DO
4313  k= (i+j)/2
4314  IF (u < x(k)) THEN
4315  j= k
4316  ELSE
4317  i= k
4318  ENDIF
4319  IF (j <= i+1) EXIT
4320  ENDDO
4321  ENDIF
4322 *
4323  dx= u-x(i)
4324 *
4325 * evaluate the spline
4326 *
4327  IF (Present(f)) f= y(i)+dx*(b(i)+dx*(c(i)+dx*d(i)))
4328  IF (Present(fp)) fp= b(i)+dx*(two*c(i) + dx*three*d(i))
4329  IF (Present(fpp)) fpp= two*c(i) + dx*six*d(i)
4330  IF (Present(fppp)) fppp= six*d(i)
4331 *
4332  RETURN
4333 *

◆ hto_seval3singlel()

subroutine hto_gridlow::hto_seval3singlel ( real*8, intent(in)  u,
real*8, dimension(gdim)  b,
real*8, dimension(gdim)  c,
real*8, dimension(gdim)  d,
integer  top,
integer  gdim,
real*8, intent(out), optional  f,
real*8, intent(out), optional  fp,
real*8, intent(out), optional  fpp,
real*8, intent(out), optional  fppp 
)

Definition at line 4467 of file CALLING_cpHTO.f.

4467 *
4468 * ---------------------------------------------------------------------------
4469 *
4470  real*8,INTENT(IN) :: u
4471 * abscissa at which the spline is to be evaluated
4472 *
4473  INTEGER j,k,n,l,top,gdim
4474 *
4475  real*8, dimension(22) :: xc,yc
4476  real*8, dimension(22) :: x,y
4477  real*8, DIMENSION(gdim) :: b,c,d
4478 * linear,quadratic,cubic coeff
4479 *
4480  real*8,INTENT(OUT),OPTIONAL:: f,fp,fpp,fppp
4481 * function, 1st,2nd,3rd deriv
4482 *
4483  INTEGER, SAVE :: i=1
4484  real*8 :: dx
4485  real*8,PARAMETER:: two=2.0, three=3.0, six=6.0
4486 *
4487 * The grid
4488 *
4489  DATA (xc(l),l=1,22)/
4490  # 190.d0,191.d0,192.d0,193.d0,194.d0,195.d0,196.d0,197.d0,198.d0,
4491  # 199.d0,200.d0,240.d0,241.d0,242.d0,243.d0,244.d0,245.d0,246.d0,
4492  # 247.d0,248.d0,249.d0,250.d0/
4493 *
4494  DATA (yc(l),l=1,22)/
4495  # 0.10346d1,0.10750d1,0.11151d1,0.11549d1,0.11942d1,0.12329d1,
4496  # 0.12708d1,0.13083d1,0.13456d1,0.13832d1,0.14212d1,
4497  # 0.32401d1,0.32994d1,0.33593d1,0.34200d1,0.34813d1,0.35433d1,
4498  # 0.36061d1,0.36695d1,0.37336d1,0.37984d1,0.38640d1/
4499 *
4500  n= 22
4501  FORALL(l=1:22)
4502  x(l)= xc(l)
4503  y(l)= yc(l)
4504  ENDFORALL
4505 *
4506 *.....First check if u is in the same interval found on the
4507 * last call to Seval.............................................
4508 *
4509  IF ( (i<1) .OR. (i >= n) ) i=1
4510  IF ( (u < x(i)) .OR. (u >= x(i+1)) ) THEN
4511  i=1
4512 *
4513 * binary search
4514 *
4515  j= n+1
4516  DO
4517  k= (i+j)/2
4518  IF (u < x(k)) THEN
4519  j= k
4520  ELSE
4521  i= k
4522  ENDIF
4523  IF (j <= i+1) EXIT
4524  ENDDO
4525  ENDIF
4526 *
4527  dx= u-x(i)
4528 *
4529 * evaluate the spline
4530 *
4531  IF (Present(f)) f= y(i)+dx*(b(i)+dx*(c(i)+dx*d(i)))
4532  IF (Present(fp)) fp= b(i)+dx*(two*c(i) + dx*three*d(i))
4533  IF (Present(fpp)) fpp= two*c(i) + dx*six*d(i)
4534  IF (Present(fppp)) fppp= six*d(i)
4535 *
4536  RETURN
4537 *
hto_rzeta
Definition: CALLING_cpHTO.f:2055
hto_masses::mm
real *8, parameter mm
Definition: CALLING_cpHTO.f:78
hto_aux_hcp::cxtmbs
real *8 cxtmbs
Definition: CALLING_cpHTO.f:62
hto_cmplx_root::cr
real *8 function, dimension(2) cr(x, ep)
Definition: CALLING_cpHTO.f:665
value
pymela::gHIGGS_KAPPA value("gHIGGS_KAPPA_TILDE", pymela::gHIGGS_KAPPA_TILDE) .value("SIZE_HQQ"
hto_asinp::m20
real *8 m20
Definition: CALLING_cpHTO.f:2062
hto_acmplx_pro
Definition: CALLING_cpHTO.f:257
hto_aux_hcp::xq
real *8 xq
Definition: CALLING_cpHTO.f:62
hto_aux_hbb::cctvi
real *8, dimension(2) cctvi
Definition: CALLING_cpHTO.f:227
hto_pole
subroutine hto_pole(m, mhb, ghb)
Definition: CALLING_cpHTO.f:5038
hto_masses::swr
real *8, parameter swr
Definition: CALLING_cpHTO.f:89
hto_deriv
real *8 function, dimension(10, 2) hto_deriv(scal, rhm)
Definition: CALLING_cpHTO.f:4545
hto_gh
subroutine hto_gh(muh, cpgh)
Definition: CALLING_cpHTO.f:5094
hto_aux_hbb::cxw
real *8, dimension(2) cxw
Definition: CALLING_cpHTO.f:227
hto_aux_hcp::cpw
real *8, dimension(2) cpw
Definition: CALLING_cpHTO.f:67
hto_aux_hcp::qcdc
integer qcdc
Definition: CALLING_cpHTO.f:61
hto_aux_hcp::clwtb
real *8, dimension(2) clwtb
Definition: CALLING_cpHTO.f:67
hto_masses::mcq
real *8, parameter mcq
Definition: CALLING_cpHTO.f:82
hto_units::one
real *8, parameter one
Definition: CALLING_cpHTO.f:184
hto_rootw
Definition: CALLING_cpHTO.f:245
hto_sp_fun::hto_init_niels
subroutine hto_init_niels
Definition: CALLING_cpHTO.f:1822
hto_dzpar::fr2c
real *8 fr2c
Definition: CALLING_cpHTO.f:2047
hto_riemann::rz3
real *8, parameter rz3
Definition: CALLING_cpHTO.f:200
hto_hbb_cp
Definition: CALLING_cpHTO.f:3586
hto_masses::mz
real *8, parameter mz
Definition: CALLING_cpHTO.f:76
hto_cmplx_rootz
Definition: CALLING_cpHTO.f:680
hto_aux_hcp::cxt
real *8 cxt
Definition: CALLING_cpHTO.f:62
hto_nffix
Definition: CALLING_cpHTO.f:2070
hto_masses::mdq
real *8, parameter mdq
Definition: CALLING_cpHTO.f:81
hto_colour::ca
real *8 ca
Definition: CALLING_cpHTO.f:2059
hto_asfthr::m2b
real *8 m2b
Definition: CALLING_cpHTO.f:2077
hto_units::ci
real *8, dimension(1:2) ci
Definition: CALLING_cpHTO.f:189
hto_set_phys_const
Definition: CALLING_cpHTO.f:239
hto_asfthr::m2t
real *8 m2t
Definition: CALLING_cpHTO.f:2077
hto_qcd
Definition: CALLING_cpHTO.f:3031
hto_aux_hcp::yimt
real *8 yimt
Definition: CALLING_cpHTO.f:62
hto_dzero
real *8 function hto_dzero(A0, B0, EPS, MAXF, F, MODE)
Definition: CALLING_cpHTO.f:2683
hto_cpoles
subroutine hto_cpoles(n, xcp, fvcp, iflag)
Definition: CALLING_cpHTO.f:6768
hto_riemann
Definition: CALLING_cpHTO.f:195
hto_betacom::beta2
real *8, dimension(3:6) beta2
Definition: CALLING_cpHTO.f:2080
hto_betacom::beta3
real *8, dimension(3:6) beta3
Definition: CALLING_cpHTO.f:2080
hto_initalphasr0
subroutine hto_initalphasr0(IORD, FR2, R0, ASI, MC, MB, MT)
Definition: CALLING_cpHTO.f:2159
hto_lquarkqcd
real *8 function, dimension(2) hto_lquarkqcd(scal, psi, ps0i, xmsi, xm0i, type)
Definition: CALLING_cpHTO.f:7307
hto_aux_hcp::cxtmb
real *8 cxtmb
Definition: CALLING_cpHTO.f:62
hto_aux_hcp::cxq
real *8 cxq
Definition: CALLING_cpHTO.f:62
hto_ln_2_riemann::lnsrs
real *8 function, dimension(2) lnsrs(x, y)
Definition: CALLING_cpHTO.f:523
hto_solve_nonlin
Definition: CALLING_cpHTO.f:5303
hto_acmplx_rat::cq
real *8 function, dimension(2) cq(x, y)
Definition: CALLING_cpHTO.f:298
hto_aux_hbb::cxwc
real *8, dimension(2) cxwc
Definition: CALLING_cpHTO.f:227
hto_aux_hcp::clxs
real *8 clxs
Definition: CALLING_cpHTO.f:62
hto_dzpar::mbc
real *8 mbc
Definition: CALLING_cpHTO.f:2047
hto_aux_hbb::cctq
real *8, dimension(2) cctq
Definition: CALLING_cpHTO.f:227
hto_units::co
real *8, dimension(1:2) co
Definition: CALLING_cpHTO.f:188
hto_aux_hcp::cxtmbi
real *8 cxtmbi
Definition: CALLING_cpHTO.f:62
hto_set_phys_const::g_f
real *8 g_f
Definition: CALLING_cpHTO.f:240
hto_hbb_cp::hto_sshh
real *8 function hto_sshh(x)
Definition: CALLING_cpHTO.f:3590
hto_asfthr::ast
real *8 ast
Definition: CALLING_cpHTO.f:2077
hto_rzeta::zeta
real *8, dimension(6) zeta
Definition: CALLING_cpHTO.f:2056
hto_dzpar::asmurc
real *8 asmurc
Definition: CALLING_cpHTO.f:2047
hto_aux_hcp::cxmu
real *8 cxmu
Definition: CALLING_cpHTO.f:62
hto_aspar::naord
integer naord
Definition: CALLING_cpHTO.f:2065
hto_aux_hcp::clxu
real *8 clxu
Definition: CALLING_cpHTO.f:62
hto_acmplx_rat
Definition: CALLING_cpHTO.f:292
hto_betafct
subroutine hto_betafct
Definition: CALLING_cpHTO.f:2644
hto_masses::msq
real *8, parameter msq
Definition: CALLING_cpHTO.f:83
hto_aux_hcp::cxu
real *8 cxu
Definition: CALLING_cpHTO.f:62
hto_optcp
Definition: CALLING_cpHTO.f:233
hto_asinp::as0
real *8 as0
Definition: CALLING_cpHTO.f:2062
hto_rootw::inc
integer inc
Definition: CALLING_cpHTO.f:246
hto_aux_hcp::cxtaus
real *8 cxtaus
Definition: CALLING_cpHTO.f:62
hto_aux_hbb::cxz
real *8, dimension(2) cxz
Definition: CALLING_cpHTO.f:227
hto_ln_2_riemann
Definition: CALLING_cpHTO.f:517
hto_asinp
Definition: CALLING_cpHTO.f:2061
hto_aux_hcp::cxb
real *8 cxb
Definition: CALLING_cpHTO.f:62
hto_aux_hcp::cxs
real *8 cxs
Definition: CALLING_cpHTO.f:62
hto_evnfthr
subroutine hto_evnfthr(MC2, MB2, MT2)
Definition: CALLING_cpHTO.f:2451
hto_masses::swi
real *8, parameter swi
Definition: CALLING_cpHTO.f:90
hto_masses::muq
real *8, parameter muq
Definition: CALLING_cpHTO.f:80
hto_aux_hcp
Definition: CALLING_cpHTO.f:60
hto_fmmsplinesinglel
subroutine hto_fmmsplinesinglel(b, c, d, top, gdim)
Definition: CALLING_cpHTO.f:4369
hto_transfmh
Definition: CALLING_cpHTO.f:251
hto_sp_fun::hto_li2_srsz
real *8 function, dimension(2) hto_li2_srsz(x, y, unit)
Definition: CALLING_cpHTO.f:1065
hto_sp_fun
Definition: CALLING_cpHTO.f:753
hto_masses::mtl
real *8, parameter mtl
Definition: CALLING_cpHTO.f:79
hto_aux_hbb::rcmw
real *8, dimension(2) rcmw
Definition: CALLING_cpHTO.f:227
hto_dzpar::murc
real *8 murc
Definition: CALLING_cpHTO.f:2047
hto_as
real *8 function hto_as(R2, R20, AS0, NF)
Definition: CALLING_cpHTO.f:2521
hto_aux_hbb::xtop
real *8 xtop
Definition: CALLING_cpHTO.f:226
hto_aux_hcp::clxe
real *8 clxe
Definition: CALLING_cpHTO.f:62
hto_findalphasr0
real *8 function hto_findalphasr0(ASI)
Definition: CALLING_cpHTO.f:2142
hto_units
Definition: CALLING_cpHTO.f:179
hto_root_find2::hto_zeroin
real *8 function hto_zeroin(f, ax, bx, aerr, rerr)
Definition: CALLING_cpHTO.f:3428
hto_frrat::logfr
real *8 logfr
Definition: CALLING_cpHTO.f:2074
hto_dzpar
Definition: CALLING_cpHTO.f:2045
hto_aux_hcp::clxtau
real *8 clxtau
Definition: CALLING_cpHTO.f:62
hto_full_ln
Definition: CALLING_cpHTO.f:464
hto_fmmsplinesingleht
subroutine hto_fmmsplinesingleht(b, c, d, top, gdim)
Definition: CALLING_cpHTO.f:4131
hto_aux_hcp::cxts
real *8 cxts
Definition: CALLING_cpHTO.f:62
hto_aux_hcp::clxc
real *8 clxc
Definition: CALLING_cpHTO.f:62
hto_aux_hcp::cxe
real *8 cxe
Definition: CALLING_cpHTO.f:62
hto_transfmh::tmuh
real *8 tmuh
Definition: CALLING_cpHTO.f:252
hto_aux_hcp::cxls
real *8 cxls
Definition: CALLING_cpHTO.f:62
hto_aspar::nastps
integer nastps
Definition: CALLING_cpHTO.f:2065
hto_units::eps
real *8, parameter eps
Definition: CALLING_cpHTO.f:183
hto_aux_hcp::gtop
integer gtop
Definition: CALLING_cpHTO.f:61
hto_varflv
Definition: CALLING_cpHTO.f:2067
hto_ferbos
Definition: CALLING_cpHTO.f:219
hto_asnf1
real *8 function hto_asnf1(ASNF, LOGRH, NF)
Definition: CALLING_cpHTO.f:2368
hto_root_find2
Definition: CALLING_cpHTO.f:3424
hto_aux_hcp::clxb
real *8 clxb
Definition: CALLING_cpHTO.f:62
hto_seval3singlel
subroutine hto_seval3singlel(u, b, c, d, top, gdim, f, fp, fpp, fppp)
Definition: CALLING_cpHTO.f:4467
hto_dzpar::mtc
real *8 mtc
Definition: CALLING_cpHTO.f:2047
hto_nffix::nff
integer nff
Definition: CALLING_cpHTO.f:2071
hto_aux_hbb::xb
real *8 xb
Definition: CALLING_cpHTO.f:226
hto_aux_hcp::cxc
real *8 cxc
Definition: CALLING_cpHTO.f:62
hto_aux_hcp::cxcs
real *8 cxcs
Definition: CALLING_cpHTO.f:62
hto_lb0af_em
real *8 function, dimension(2) hto_lb0af_em(scal, psi, ps0i, xmsi, xm0i)
Definition: CALLING_cpHTO.f:7541
hto_aux_hcp::cxes
real *8 cxes
Definition: CALLING_cpHTO.f:62
hto_aux_hcp::cpz
real *8, dimension(2) cpz
Definition: CALLING_cpHTO.f:67
hto_aux_hbb::cxws
real *8, dimension(2) cxws
Definition: CALLING_cpHTO.f:227
hto_sp_fun::hto_li3_srsz
real *8 function, dimension(2) hto_li3_srsz(x, y, unit)
Definition: CALLING_cpHTO.f:1138
hto_full_ln::fln
real *8 function, dimension(2) fln(x, y)
Definition: CALLING_cpHTO.f:470
hto_asfthr::asb
real *8 asb
Definition: CALLING_cpHTO.f:2077
hto_sp_fun::hto_s_niels_up4
recursive real *8 function, dimension(6, 2) hto_s_niels_up4(x)
Definition: CALLING_cpHTO.f:766
hto_aux_hcp::clcts
real *8, dimension(2) clcts
Definition: CALLING_cpHTO.f:67
hto_cmplx_rootz::crz
real *8 function, dimension(2) crz(x, y)
Definition: CALLING_cpHTO.f:686
hto_asfthr::m2c
real *8 m2c
Definition: CALLING_cpHTO.f:2077
hto_varflv::ivfns
integer ivfns
Definition: CALLING_cpHTO.f:2068
hto_aux_hcp::clxd
real *8 clxd
Definition: CALLING_cpHTO.f:62
hto_masses::mt
real *8 mt
Definition: CALLING_cpHTO.f:73
hto_gridlow
subroutine hto_gridlow(mass, evalue)
Definition: CALLING_cpHTO.f:4343
hto_aux_hcp::cxtau
real *8 cxtau
Definition: CALLING_cpHTO.f:62
hto_initalphas
subroutine hto_initalphas(IORD, FR2, MUR, ASMUR, MC, MB, MT)
Definition: CALLING_cpHTO.f:2089
hto_masses
Definition: CALLING_cpHTO.f:72
hto_dzpar::iordc
integer iordc
Definition: CALLING_cpHTO.f:2046
hto_masses::mw
real *8, parameter mw
Definition: CALLING_cpHTO.f:75
hto_ferbos::ifb
integer ifb
Definition: CALLING_cpHTO.f:220
hto_aux_hcp::scalec
real *8 scalec
Definition: CALLING_cpHTO.f:62
hto_aux_hcp::cxqs
real *8 cxqs
Definition: CALLING_cpHTO.f:62
hto_lb0af_dm
real *8 function, dimension(2) hto_lb0af_dm(scal, psi, ps0i, xmsi, xm0i)
Definition: CALLING_cpHTO.f:7483
hto_aux_hbb
Definition: CALLING_cpHTO.f:225
hto_riemann::pis
real *8, parameter pis
Definition: CALLING_cpHTO.f:197
hto_masses::mb
real *8, parameter mb
Definition: CALLING_cpHTO.f:85
hto_lb021_dm_cp
real *8 function, dimension(2) hto_lb021_dm_cp(scal, psi, ps0i, xmsi, xm0i)
Definition: CALLING_cpHTO.f:7591
hto_aux_hcp::clxmu
real *8 clxmu
Definition: CALLING_cpHTO.f:62
hto_aux_hbb::clw
real *8, dimension(2) clw
Definition: CALLING_cpHTO.f:227
hto_dzpar::mcc
real *8 mcc
Definition: CALLING_cpHTO.f:2047
hto_aux_hcp::cxus
real *8 cxus
Definition: CALLING_cpHTO.f:62
hto_seval3singleht
subroutine hto_seval3singleht(u, b, c, d, top, gdim, f, fp, fpp, fppp)
Definition: CALLING_cpHTO.f:4246
hto_asfthr
Definition: CALLING_cpHTO.f:2076
hto_masses::szi
real *8, parameter szi
Definition: CALLING_cpHTO.f:92
hto_colour
Definition: CALLING_cpHTO.f:2058
hto_cmplx_root
Definition: CALLING_cpHTO.f:659
hto_aux_hcp::cxbs
real *8 cxbs
Definition: CALLING_cpHTO.f:62
hto_qcd::hto_run_bc
real *8 function, dimension(2) hto_run_bc(scal)
Definition: CALLING_cpHTO.f:3157
hto_aux_hcp::cxd
real *8 cxd
Definition: CALLING_cpHTO.f:62
hto_aux_hcp::cxmus
real *8 cxmus
Definition: CALLING_cpHTO.f:62
hto_aux_hbb::ccts
real *8, dimension(2) ccts
Definition: CALLING_cpHTO.f:227
hto_aux_hcp::muhcp
real *8 muhcp
Definition: CALLING_cpHTO.f:62
hto_aux_hcp::cxwi
real *8, dimension(2) cxwi
Definition: CALLING_cpHTO.f:67
hto_aux_hcp::cxtc
real *8 cxtc
Definition: CALLING_cpHTO.f:62
hto_masses::szr
real *8, parameter szr
Definition: CALLING_cpHTO.f:91
hto_set_phys_const::imt
real *8 imt
Definition: CALLING_cpHTO.f:240
hto_aux_hbb::csts
real *8, dimension(2) csts
Definition: CALLING_cpHTO.f:227
hto_frrat
Definition: CALLING_cpHTO.f:2073
hto_dzpar::r0c
real *8 r0c
Definition: CALLING_cpHTO.f:2047
hto_aux_hcp::clxt
real *8 clxt
Definition: CALLING_cpHTO.f:62
hto_aux_hcp::cxbc
real *8 cxbc
Definition: CALLING_cpHTO.f:62
hto_set_phys_const::als
real *8 als
Definition: CALLING_cpHTO.f:240
hto_acmplx_pro::cp
real *8 function, dimension(2) cp(x, y)
Definition: CALLING_cpHTO.f:263
hto_asfthr::asc
real *8 asc
Definition: CALLING_cpHTO.f:2077
hto_aux_hcp::cxds
real *8 cxds
Definition: CALLING_cpHTO.f:62
hto_masses::me
real *8, parameter me
Definition: CALLING_cpHTO.f:77
hto_betacom::beta0
real *8, dimension(3:6) beta0
Definition: CALLING_cpHTO.f:2080
hto_betacom
Definition: CALLING_cpHTO.f:2079
hto_puttime
Definition: CALLING_cpHTO.f:97
hto_alphas
real *8 function hto_alphas(MUR)
Definition: CALLING_cpHTO.f:2269
hto_units::zero
real *8, parameter zero
Definition: CALLING_cpHTO.f:185
hto_colour::tr
real *8 tr
Definition: CALLING_cpHTO.f:2059
hto_aux_hcp::cxss
real *8 cxss
Definition: CALLING_cpHTO.f:62
hto_solve_nonlin::hto_hbrd
subroutine, public hto_hbrd(HTO_FCN, n, x, fvec, epsfcn, tol, info, diag)
Definition: CALLING_cpHTO.f:5311
hto_cmplx_srs_root
Definition: CALLING_cpHTO.f:618
hto_gridht
subroutine hto_gridht(mass, evalue)
Definition: CALLING_cpHTO.f:4106
hto_betacom::beta1
real *8, dimension(3:6) beta1
Definition: CALLING_cpHTO.f:2080
hto_riemann::rz2
real *8, parameter rz2
Definition: CALLING_cpHTO.f:199
hto_aspar
Definition: CALLING_cpHTO.f:2064
hto_aux_hcp::cxl
real *8 cxl
Definition: CALLING_cpHTO.f:62