Page MenuHomeHEPForge

parameters.GravTest.f90
No OneTemporary

parameters.GravTest.f90

! $Id: parameters.GravTest.f90,v 1.4 2006/06/16 13:31:48 kilian Exp $
!
! Copyright (C) 1999-2009 by
! Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
! Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
! Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
!
! WHIZARD is free software; you can redistribute it and/or modify it
! under the terms of the GNU General Public License as published by
! the Free Software Foundation; either version 2, or (at your option)
! any later version.
!
! WHIZARD is distributed in the hope that it will be useful, but
! WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License
! along with this program; if not, write to the Free Software
! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
module parameters_gravtest
use kinds
use constants
use sm_physics !NODEP!
implicit none
private
public :: import_from_whizard, model_update_alpha_s
real(default), public :: e, g, e_em
real(default), public :: sinthw, costhw, sin2thw, tanthw
real(default), public :: qelep, qeup, qedwn
real(default), public :: ttop, tbot, tch, ttau, tw
real(default), public :: ltop, lbot, lc, ltau, lw
complex(default), public :: qlep, qup, qdwn, gcc, qw, &
gzww, gwww, ghww, ghhww, ghzz, ghhzz, &
ghbb, ghtt, ghcc, ghtautau, gh3, gh4, &
ghgaga, ghgaz, ghgg, ghmm, &
iqw, igzww, igwww, gw4, gzzww, gazww, gaaww
real(default), public :: vev
complex(default), dimension(2), public :: &
gncneu, gnclep, gncup, gncdwn
real(default), dimension(1:46), public :: mass, width
real(default) :: as
complex(default), public :: gs, igs
contains
subroutine import_from_whizard (par_array)
real(default), dimension(36), intent(in) :: par_array
type :: parameter_set
real(default) :: gf
real(default) :: mZ
real(default) :: mW
real(default) :: mH
real(default) :: alphas
real(default) :: me
real(default) :: mmu
real(default) :: mtau
real(default) :: ms
real(default) :: mc
real(default) :: mb
real(default) :: mtop
real(default) :: wtop
real(default) :: wZ
real(default) :: wW
real(default) :: wH
real(default) :: mgg
real(default) :: wgg
real(default) :: mse
real(default) :: msmu
real(default) :: mstau
real(default) :: wse
real(default) :: wsmu
real(default) :: wstau
real(default) :: mph
real(default) :: wph
real(default) :: khgaz
real(default) :: khgaga
real(default) :: khgg
real(default) :: ggrav
real(default) :: xi0
real(default) :: xipm
real(default) :: v
real(default) :: cw
real(default) :: sw
real(default) :: ee
end type parameter_set
type(parameter_set) :: par
!!! This corresponds to 1/alpha = 137.03598949333
real(default), parameter :: &
alpha = 1.0_default/137.03598949333_default
e_em = sqrt(4.0_default * PI * alpha)
par%gf = par_array(1)
par%mZ = par_array(2)
par%mW = par_array(3)
par%mH = par_array(4)
par%alphas = par_array(5)
par%me = par_array(6)
par%mmu = par_array(7)
par%mtau = par_array(8)
par%ms = par_array(9)
par%mc = par_array(10)
par%mb = par_array(11)
par%mtop = par_array(12)
par%wtop = par_array(13)
par%wZ = par_array(14)
par%wW = par_array(15)
par%wH = par_array(16)
par%mgg = par_array(17)
par%wgg = par_array(18)
par%mse = par_array(19)
par%msmu = par_array(20)
par%mstau = par_array(21)
par%wse = par_array(22)
par%wsmu = par_array(23)
par%wstau = par_array(24)
par%mph = par_array(25)
par%wph = par_array(26)
par%khgaz = par_array(27)
par%khgaga = par_array(28)
par%khgg = par_array(29)
par%ggrav = par_array(30)
par%xi0 = par_array(31)
par%xipm = par_array(32)
par%v = par_array(33)
par%cw = par_array(34)
par%sw = par_array(35)
par%ee = par_array(36)
mass(1:46) = 0
width(1:46) = 0
mass(3) = par%ms
mass(4) = par%mc
mass(5) = par%mb
mass(6) = par%mtop
width(6) = par%wtop
mass(11) = par%me
mass(13) = par%mmu
mass(15) = par%mtau
mass(23) = par%mZ
width(23) = par%wZ
mass(24) = par%mW
width(24) = par%wW
mass(25) = par%mH
width(25) = par%wH
mass(26) = par%xi0 * mass(23)
width(26) = 0
mass(27) = par%xipm * mass(24)
width(27) = 0
mass(39) = par%mgg
width(39) = par%wgg
mass(41) = par%mse
width(41) = par%wse
mass(43) = par%msmu
width(43) = par%wsmu
mass(45) = par%mstau
width(45) = par%wstau
mass(46) = par%mph
width(46) = par%wph
ttop = 4.0_default * mass(6)**2 / mass(25)**2
tbot = 4.0_default * mass(5)**2 / mass(25)**2
tch = 4.0_default * mass(4)**2 / mass(25)**2
ttau = 4.0_default * mass(15)**2 / mass(25)**2
tw = 4.0_default * mass(24)**2 / mass(25)**2
ltop = 4.0_default * mass(6)**2 / mass(23)**2
lbot = 4.0_default * mass(5)**2 / mass(23)**2
lc = 4.0_default * mass(4)**2 / mass(23)**2
ltau = 4.0_default * mass(15)**2 / mass(23)**2
lw = 4.0_default * mass(24)**2 / mass(23)**2
vev = par%v
e = par%ee
sinthw = par%sw
sin2thw = sinthw**2
costhw = par%cw
tanthw = sinthw/costhw
qelep = - 1
qeup = 2.0_default / 3.0_default
qedwn = - 1.0_default / 3.0_default
g = e / sinthw
gcc = - g / 2 / sqrt (2.0_default)
gncneu(1) = - g / 2 / costhw * ( + 0.5_default)
gnclep(1) = - g / 2 / costhw * ( - 0.5_default - 2 * qelep * sin2thw)
gncup(1) = - g / 2 / costhw * ( + 0.5_default - 2 * qeup * sin2thw)
gncdwn(1) = - g / 2 / costhw * ( - 0.5_default - 2 * qedwn * sin2thw)
gncneu(2) = - g / 2 / costhw * ( + 0.5_default)
gnclep(2) = - g / 2 / costhw * ( - 0.5_default)
gncup(2) = - g / 2 / costhw * ( + 0.5_default)
gncdwn(2) = - g / 2 / costhw * ( - 0.5_default)
qlep = - e * qelep
qup = - e * qeup
qdwn = - e * qedwn
qw = e
iqw = (0,1)*qw
gzww = g * costhw
igzww = (0,1)*gzww
gwww = g
igwww = (0,1)*gwww
gw4 = gwww**2
gzzww = gzww**2
gazww = gzww * qw
gaaww = qw**2
ghww = mass(24) * g
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! This is for the old SM3:
!!! ghhww = (0,1) * g / Sqrt(2.0_default)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ghhww = g**2 / 2.0_default
ghzz = mass(23) * g / costhw
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! This is for the old SM3:
!!! ghhzz = (0,1) * g / costhw / Sqrt(2.0_default)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ghhzz = g**2 / 2.0_default / costhw**2
ghtt = - mass(6) / vev
ghbb = - mass(5) / vev
ghcc = - mass(4) / vev
ghtautau = - mass(15) / vev
ghmm = - mass(13) / vev
gh3 = - 3 * mass(25)**2 / vev
!!! gh4 = mass(25) / vev !!! Old SM3
gh4 = - 3 * mass(25)**2 / vev**2
!!! Color flow basis, divide by sqrt(2)
gs = sqrt(2.0_default * PI * par%alphas)
igs = cmplx(0.0_default, 1.0_default, kind=default) * gs
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! Higgs anomaly couplings
!!! SM LO loop factor (top,bottom,W)
ghgaga = alpha / vev / 2.0_default / PI * &
abs(( 4.0_default * (fonehalf(ttop) + fonehalf(tch)) &
+ fonehalf(tbot)) / 3.0_default + fonehalf(ttau) + fone(tw)) &
* sqrt(par%khgaga)
!!! asymptotic limit:
!!! ghgaga = (par%ee)**2 / vev / &
!!! 9.0_default / pi**2
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! SM LO loop factor (only top and W)
ghgaz = e * e_em / 8.0_default / PI**2 / vev * Abs( &
( - 2.0_default + &
16.0_default/3.0_default * sin2thw) * &
(tri_i1(ttop,ltop) - tri_i2(ttop,ltop)) / costhw &
+ ( - 1.0_default + &
4.0_default/3.0_default * sin2thw) &
* (tri_i1(tbot,lbot) - tri_i2(tbot,lbot)) / costhw &
- costhw * ( 4.0_default * (3.0_default - tanthw**2) * &
tri_i2(tw,lw) + ((1 + 2.0_default/tw) * tanthw**2 - ( &
5.0_default + 2.0_default/tw)) * tri_i1(tw,lw))) &
/sinthw * sqrt(par%khgaz)
!!! SM LO order loop factor with
!!! N(N)LO K factor = 2.1 (only top)
!!! Limit of infinite top quark mass:
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! We use par%gg because of sqrt(2) above
ghgg = par%alphas / vev / 4.0_default / PI * &
abs(fonehalf(ttop) + fonehalf(tbot) + fonehalf(tch)) * &
sqrt(par%khgg)
!!! ghgg = par%alphas / 3.0_default &
!!! / vev / pi * 2.1_default
end subroutine import_from_whizard
subroutine model_update_alpha_s (alpha_s)
real(default), intent(in) :: alpha_s
gs = sqrt(2.0_default * PI * alpha_s)
igs = cmplx(0.0_default, 1.0_default, kind=default) * gs
!!! Hgg should not have running alpha_s
end subroutine model_update_alpha_s
end module parameters_gravtest

File Metadata

Mime Type
text/plain
Expires
Sat, Dec 21, 5:46 PM (9 h, 43 m)
Storage Engine
blob
Storage Format
Raw Data
Storage Handle
4023692
Default Alt Text
parameters.GravTest.f90 (9 KB)

Event Timeline