JHUGen MELA  v2.4.1
Matrix element calculations as used in JHUGen. MELA is an important tool that was used for the Higgs boson discovery and for precise measurements of its structure and interactions. Please see the website https://spin.pha.jhu.edu/ and papers cited there for more details, and kindly cite those papers when using this code.
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
Generated by   doxygen 1.8.17