Page MenuHomeHEPForge
Files F11221564

No OneTemporary
Actions

View Options

This file is larger than 256 KB, so syntax highlighting was skipped.
Index: trunk/src/models/parameters.GravTest.f90
===================================================================
--- trunk/src/models/parameters.GravTest.f90 (revision 2698)
+++ trunk/src/models/parameters.GravTest.f90 (revision 2699)
@@ -1,270 +1,261 @@
! $Id: parameters.GravTest.f90,v 1.4 2006/06/16 13:31:48 kilian Exp $
!
-! Copyright (C) 1999-2009 by
+! Copyright (C) 1999-2010 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
complex(default), public :: ggrav
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
ggrav = par%ggrav
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
Index: trunk/src/omega/src/modellib_MSSM.mli
===================================================================
--- trunk/src/omega/src/modellib_MSSM.mli (revision 2698)
+++ trunk/src/omega/src/modellib_MSSM.mli (revision 2699)
@@ -1,46 +1,46 @@
(* $Id$
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. *)
(* \thocwmodulesection{More Hardcoded Models} *)
module type MSSM_flags =
sig
val include_goldstone : bool
val include_four : bool
val ckm_present : bool
val gravitino : bool
end
module MSSM_no_goldstone : MSSM_flags
module MSSM_goldstone : MSSM_flags
module MSSM_no_4 : MSSM_flags
module MSSM_no_4_ckm : MSSM_flags
module MSSM_Grav : MSSM_flags
-module MSSM : functor (F: MSSM_flags) -> Model.T with module Ch = Charges.Null
+module MSSM : functor (F: MSSM_flags) -> Model.T with module Ch = Charges.QQ
(*i
* Local Variables:
* mode:caml
* indent-tabs-mode:nil
* page-delimiter:"^(\\* .*\n"
* End:
i*)
Index: trunk/src/omega/src/modellib_NMSSM.ml
===================================================================
--- trunk/src/omega/src/modellib_NMSSM.ml (revision 2698)
+++ trunk/src/omega/src/modellib_NMSSM.ml (revision 2699)
@@ -1,1509 +1,1561 @@
(* $Id$
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. *)
let rcs_file = RCS.parse "Modellib_NMSSM" ["NMSSM"]
{ RCS.revision = "$Revision$";
RCS.date = "$Date$";
RCS.author = "$Author$";
RCS.source
= "$URL$" }
(* \thocwmodulesection{Next-to-Minimal Supersymmetric Standard Model} *)
(* This is based on the NMSSM implementation by Felix Braam. Note that for the
Higgs sector vertices the conventions of the Franke/Fraas paper have been
used. *)
module type NMSSM_flags =
sig
val ckm_present : bool
end
module NMSSM : NMSSM_flags =
struct
let ckm_present = false
end
module NMSSM_CKM : NMSSM_flags =
struct
let ckm_present = true
end
module NMSSM_func (Flags : NMSSM_flags) =
struct
let rcs = RCS.rename rcs_file "Modellib_NMSSM.NMSSM"
[ "NMSSM" ]
open Coupling
let default_width = ref Timelike
let use_fudged_width = ref false
let options = Options.create
[ "constant_width", Arg.Unit (fun () -> default_width := Constant),
"use constant width (also in t-channel)";
"fudged_width", Arg.Set use_fudged_width,
"use fudge factor for charge particle width";
"custom_width", Arg.String (fun f -> default_width := Custom f),
"use custom width";
"cancel_widths", Arg.Unit (fun () -> default_width := Vanishing),
"use vanishing width"]
(* Yields a list of tuples consistig of the off-diag combinations of the elements in "set". *)
let choose2 set =
List.map (function [x;y] -> (x,y) | _ -> failwith "choose2")
(Combinatorics.choose 2 set)
(* [pairs] appends the diagonal combinations to [choose2]. *)
let rec diag = function
| [] -> []
| x1 :: rest -> (x1, x1) :: diag rest
let pairs l = choose2 l @ diag l
let rec cloop set i j k =
if i > ((List.length set)-1) then []
else if j > i then cloop set (succ i) (j-i-1) (j-i-1)
else if k > j then cloop set i (succ j) (k-j-1)
else (List.nth set i, List.nth set j, List.nth set k) :: cloop set i j (succ k)
let triples set = cloop set 0 0 0
let rec two_and_one' l1 z n =
if n < 0 then []
else
((fst (List.nth (pairs l1) n)),(snd (List.nth (pairs l1) n)), z):: two_and_one' l1 z (pred n)
let two_and_one l1 l2 =
let f z = two_and_one' l1 z ((List.length (pairs l1))-1)
in
List.flatten ( List.map f l2 )
type gen =
| G of int | GG of gen*gen
let rec string_of_gen = function
| G n when n > 0 -> string_of_int n
| G n -> string_of_int (abs n) ^ "c"
| GG (g1,g2) -> string_of_gen g1 ^ "_" ^ string_of_gen g2
(* With this we distinguish the flavour. *)
type sff =
| SL | SN | SU | SD
let string_of_sff = function
| SL -> "sl" | SN -> "sn" | SU -> "su" | SD -> "sd"
(* With this we distinguish the mass eigenstates. At the moment we have to cheat
a little bit for the sneutrinos. Because we are dealing with massless
neutrinos there is only one sort of sneutrino. *)
type sfm =
| M1 | M2
let string_of_sfm = function
| M1 -> "1" | M2 -> "2"
(* We also introduce special types for the charginos and neutralinos. *)
type char =
| C1 | C2 | C1c | C2c
type neu =
| N1 | N2 | N3 | N4 | N5
let int_of_char = function
| C1 -> 1 | C2 -> 2 | C1c -> -1 | C2c -> -2
let string_of_char = function
| C1 -> "1" | C2 -> "2" | C1c -> "-1" | C2c -> "-2"
let conj_char = function
| C1 -> C1c | C2 -> C2c | C1c -> C1 | C2c -> C2
let string_of_neu = function
| N1 -> "1" | N2 -> "2" | N3 -> "3" | N4 -> "4" | N5 -> "5"
(* For the Higgs bosons, we follow the conventions of Franke/Fraas. *)
type shiggs =
| S1 | S2 | S3
type phiggs =
| P1 | P2
let string_of_shiggs = function
| S1 -> "1" | S2 -> "2" | S3 -> "3"
let string_of_phiggs = function
| P1 -> "1" | P2 -> "2"
type flavor =
| L of int | N of int
| U of int | D of int
| Sup of sfm*int | Sdown of sfm*int
| Ga | Wp | Wm | Z | Gl
| Slepton of sfm*int | Sneutrino of int
| Neutralino of neu | Chargino of char
| Gluino
| SHiggs of shiggs | Hp | Hm | PHiggs of phiggs
let string_of_fermion_type = function
| L _ -> "l" | U _ -> "u" | D _ -> "d" | N _ -> "n"
| _ -> failwith "Modellib_NMSSM.NMSSM.string_of_fermion_type: invalid fermion type"
let string_of_fermion_gen = function
| L g | U g | D g | N g -> string_of_int (abs (g))
| _ -> failwith "Modellib_NMSSM.NMSSM.string_of_fermion_gen: invalid fermion type"
type gauge = unit
let gauge_symbol () =
failwith "Modellib_NMSSM.NMSSM.gauge_symbol: internal error"
(* At this point we will forget graviton and -ino. *)
let family g = [ L g; N g; Slepton (M1,g);
Slepton (M2,g); Sneutrino g;
U g; D g; Sup (M1,g); Sup (M2,g);
Sdown (M1,g); Sdown (M2,g)]
let external_flavors () =
[ "1st Generation matter", ThoList.flatmap family [1; -1];
"2nd Generation matter", ThoList.flatmap family [2; -2];
"3rd Generation matter", ThoList.flatmap family [3; -3];
"Gauge Bosons", [Ga; Z; Wp; Wm; Gl];
"Charginos", [Chargino C1; Chargino C2; Chargino C1c; Chargino C2c];
"Neutralinos", [Neutralino N1; Neutralino N2; Neutralino N3;
Neutralino N4; Neutralino N5];
"Higgs Bosons", [SHiggs S1; SHiggs S2; SHiggs S3; Hp; Hm; PHiggs P1; PHiggs P2];
"Gluino", [Gluino]]
let flavors () = ThoList.flatmap snd (external_flavors ())
let spinor n m =
if n >= 0 && m >= 0 then
Spinor
else if
n <= 0 && m <=0 then
ConjSpinor
else
invalid_arg "Modellib_NMSSM.NMSSM.spinor: internal error"
let lorentz = function
| L g -> spinor g 0 | N g -> spinor g 0
| U g -> spinor g 0 | D g -> spinor g 0
| Chargino c -> spinor (int_of_char c) 0
| Ga | Gl -> Vector
| Wp | Wm | Z -> Massive_Vector
| SHiggs _ | PHiggs _ | Hp | Hm
| Sup _ | Sdown _ | Slepton _ | Sneutrino _ -> Scalar
| Neutralino _ | Gluino -> Majorana
let color = function
| U g -> Color.SUN (if g > 0 then 3 else -3)
| Sup (m,g) -> Color.SUN (if g > 0 then 3 else -3)
| D g -> Color.SUN (if g > 0 then 3 else -3)
| Sdown (m,g) -> Color.SUN (if g > 0 then 3 else -3)
| Gl | Gluino -> Color.AdjSUN 3
| _ -> Color.Singlet
let prop_spinor n m =
if n >= 0 && m >=0 then
Prop_Spinor
else if
n <=0 && m <=0 then
Prop_ConjSpinor
else
invalid_arg "Modellib_NMSSM.NMSSM.prop_spinor: internal error"
let propagator = function
| L g -> prop_spinor g 0 | N g -> prop_spinor g 0
| U g -> prop_spinor g 0 | D g -> prop_spinor g 0
| Chargino c -> prop_spinor (int_of_char c) 0
| Ga | Gl -> Prop_Feynman
| Wp | Wm | Z -> Prop_Unitarity
| SHiggs _ | PHiggs _ -> Prop_Scalar
| Hp | Hm -> Prop_Scalar
| Sup _ | Sdown _ | Slepton _ | Sneutrino _ -> Prop_Scalar
| Gluino -> Prop_Majorana
| Neutralino _ -> Prop_Majorana
(* Optionally, ask for the fudge factor treatment for the widths of
charged particles. Currently, this only applies to $W^\pm$ and top. *)
let width f =
if !use_fudged_width then
match f with
| Wp | Wm | U 3 | U (-3) -> Fudged
| _ -> !default_width
else
!default_width
let goldstone _ = None
let conjugate = function
| L g -> L (-g) | N g -> N (-g)
| U g -> U (-g) | D g -> D (-g)
| Sup (m,g) -> Sup (m,-g)
| Sdown (m,g) -> Sdown (m,-g)
| Slepton (m,g) -> Slepton (m,-g)
| Sneutrino g -> Sneutrino (-g)
| Gl -> Gl | Ga -> Ga | Z -> Z
| Wp -> Wm | Wm -> Wp
| SHiggs s -> SHiggs s
| PHiggs p -> PHiggs p
| Hp -> Hm | Hm -> Hp
| Gluino -> Gluino
| Neutralino n -> Neutralino n | Chargino c -> Chargino (conj_char c)
let fermion = function
| L g -> if g > 0 then 1 else -1
| N g -> if g > 0 then 1 else -1
| U g -> if g > 0 then 1 else -1
| D g -> if g > 0 then 1 else -1
| Gl | Ga | Z | Wp | Wm -> 0
| SHiggs _ | Hp | Hm | PHiggs _ -> 0
| Neutralino _ -> 2
| Chargino c -> if (int_of_char c) > 0 then 1 else -1
| Sup _ -> 0 | Sdown _ -> 0
| Slepton _ -> 0 | Sneutrino _ -> 0
| Gluino -> 2
- module Ch = Charges.Null
- let charges _ = ()
+ module Ch = Charges.QQ
+
+ let ( // ) = Algebra.Small_Rational.make
+
+ let generation' = function
+ | 1 -> [ 1//1; 0//1; 0//1]
+ | 2 -> [ 0//1; 1//1; 0//1]
+ | 3 -> [ 0//1; 0//1; 1//1]
+ | -1 -> [-1//1; 0//1; 0//1]
+ | -2 -> [ 0//1; -1//1; 0//1]
+ | -3 -> [ 0//1; 0//1; -1//1]
+ | n -> invalid_arg ("NMSSM.generation': " ^ string_of_int n)
+
+ let generation f =
+ if Flags.ckm_present then
+ []
+ else
+ match f with
+ | L n | N n | U n | D n | Sup (_,n)
+ | Sdown (_,n) | Slepton (_,n)
+ | Sneutrino n -> generation' n
+ | _ -> [0//1; 0//1; 0//1]
+
+ let charge = function
+ | L n -> if n > 0 then -1//1 else 1//1
+ | Slepton (_,n) -> if n > 0 then -1//1 else 1//1
+ | N n -> 0//1
+ | Sneutrino n -> 0//1
+ | U n -> if n > 0 then 2//3 else -2//3
+ | Sup (_,n) -> if n > 0 then 2//3 else -2//3
+ | D n -> if n > 0 then -1//3 else 1//3
+ | Sdown (_,n) -> if n > 0 then -1//3 else 1//3
+ | Gl | Ga | Z | Neutralino _ | Gluino -> 0//1
+ | Wp -> 1//1
+ | Wm -> -1//1
+ | SHiggs _ | PHiggs _ -> 0//1
+ | Hp -> 1//1
+ | Hm -> -1//1
+ | Chargino (C1 | C2) -> 1//1
+ | Chargino (C1c | C2c) -> -1//1
+
+ let lepton = function
+ | L n | N n -> if n > 0 then 1//1 else -1//1
+ | Slepton (_,n)
+ | Sneutrino n -> if n > 0 then 1//1 else -1//1
+ | _ -> 0//1
+
+ let baryon = function
+ | U n | D n -> if n > 0 then 1//1 else -1//1
+ | Sup (_,n) | Sdown (_,n) -> if n > 0 then 1//1 else -1//1
+ | _ -> 0//1
+
+ let charges f =
+ [ charge f; lepton f; baryon f] @ generation f
(* We introduce a Boolean type vc as a pseudonym for Vertex Conjugator to
distinguish between vertices containing complex mixing matrices like the
CKM--matrix or the sfermion or neutralino/chargino--mixing matrices, which
have to become complex conjugated. The true--option stands for the conjugated
vertex, the false--option for the unconjugated vertex. *)
type vc = bool
type constant =
| E | G
| Mu (*lambda*<s>*) | Lambda
| Q_lepton | Q_up | Q_down | Q_charg
| G_Z | G_CC | G_CCQ of vc*int*int
| G_NC_neutrino | G_NC_lepton | G_NC_up | G_NC_down
| I_Q_W | I_G_ZWW | G_WWWW | G_ZZWW | G_PZWW | G_PPWW
| G_SS | I_G_S | Gs
| G_NZN of neu*neu | G_CZC of char*char
| G_YUK_FFS of flavor*flavor*shiggs
| G_YUK_FFP of flavor*flavor*phiggs
| G_YUK_LCN of int
| G_YUK_UCD of int*int | G_YUK_DCU of int*int
| G_NHC of vc*neu*char
| G_YUK_C of vc*flavor*char*sff*sfm
| G_YUK_Q of vc*int*flavor*char*sff*sfm
| G_YUK_N of vc*flavor*neu*sff*sfm
| G_YUK_G of vc*flavor*sff*sfm
| G_NWC of neu*char | G_CWN of char*neu
| G_CSC of char*char*shiggs
| G_CPC of char*char*phiggs
| G_WSQ of vc*int*int*sfm*sfm
| G_SLSNW of vc*int*sfm
| G_ZSF of sff*int*sfm*sfm
| G_CICIS of neu*neu*shiggs
| G_CICIP of neu*neu*phiggs
| G_GH_WPC of phiggs | G_GH_WSC of shiggs
| G_GH_ZSP of shiggs*phiggs | G_GH_WWS of shiggs
| G_GH_ZZS of shiggs | G_GH_ZCC
| G_GH_GaCC
| G_GH4_ZZPP of phiggs*phiggs
| G_GH4_ZZSS of shiggs*shiggs
| G_GH4_ZZCC | G_GH4_GaGaCC
| G_GH4_ZGaCC | G_GH4_WWCC
| G_GH4_WWPP of phiggs*phiggs
| G_GH4_WWSS of shiggs*shiggs
| G_GH4_ZWSC of shiggs
| G_GH4_GaWSC of shiggs
| G_GH4_ZWPC of phiggs
| G_GH4_GaWPC of phiggs
| G_WWSFSF of sff*int*sfm*sfm
| G_WPSLSN of vc*int*sfm
| G_H3_SCC of shiggs
| G_H3_SSS of shiggs*shiggs*shiggs
| G_H3_SPP of shiggs*phiggs*phiggs
| G_SFSFS of shiggs*sff*int*sfm*sfm
| G_SFSFP of phiggs*sff*int*sfm*sfm
| G_HSNSL of vc*int*sfm
| G_HSUSD of vc*sfm*sfm*int*int
| G_WPSUSD of vc*sfm*sfm*int*int
| G_WZSUSD of vc*sfm*sfm*int*int
| G_WZSLSN of vc*int*sfm | G_GlGlSQSQ
| G_PPSFSF of sff
| G_ZZSFSF of sff*int*sfm*sfm | G_ZPSFSF of sff*int*sfm*sfm
| G_GlZSFSF of sff*int*sfm*sfm | G_GlPSQSQ
| G_GlWSUSD of vc*sfm*sfm*int*int
(* \begin{subequations}
\begin{align}
\alpha_{\text{QED}} &= \frac{1}{137.0359895} \\
\sin^2\theta_w &= 0.23124
\end{align}
\end{subequations}
Here we must perhaps allow for complex input parameters. So split them
into their modulus and their phase. At first, we leave them real; the
generalization to complex parameters is obvious. *)
let parameters () =
{ input = [];
derived = [];
derived_arrays = [] }
module F = Modeltools.Fusions (struct
type f = flavor
type c = constant
let compare = compare
let conjugate = conjugate
end)
(* For the couplings there are generally two possibilities concerning the
sign of the covariant derivative.
\begin{equation}
{\rm CD}^\pm = \partial_\mu \pm \ii g T^a A^a_\mu
\end{equation}
The particle data group defines the signs consistently to be positive.
Since the convention for that signs also influence the phase definitions
of the gaugino/higgsino fields via the off-diagonal entries in their
mass matrices it would be the best to adopt that convention. *)
(*** REVISED: Compatible with CD+. FB ***)
let electromagnetic_currents_3 g =
[ ((L (-g), Ga, L g), FBF (1, Psibar, V, Psi), Q_lepton);
((U (-g), Ga, U g), FBF (1, Psibar, V, Psi), Q_up);
((D (-g), Ga, D g), FBF (1, Psibar, V, Psi), Q_down)]
(*** REVISED: Compatible with CD+. FB***)
let electromagnetic_sfermion_currents g m =
[ ((Ga, Slepton (m,-g), Slepton (m,g)), Vector_Scalar_Scalar 1, Q_lepton);
((Ga, Sup (m,-g), Sup (m,g)), Vector_Scalar_Scalar 1, Q_up);
((Ga, Sdown (m,-g), Sdown (m,g)), Vector_Scalar_Scalar 1, Q_down)]
(*** REVISED: Compatible with CD+. FB***)
let electromagnetic_currents_2 c =
let cc = conj_char c in
[ ((Chargino cc, Ga, Chargino c), FBF (1, Psibar, V, Psi), Q_charg) ]
(*** REVISED: Compatible with CD+. FB***)
let neutral_currents g =
[ ((L (-g), Z, L g), FBF (1, Psibar, VA, Psi), G_NC_lepton);
((N (-g), Z, N g), FBF (1, Psibar, VA, Psi), G_NC_neutrino);
((U (-g), Z, U g), FBF (1, Psibar, VA, Psi), G_NC_up);
((D (-g), Z, D g), FBF (1, Psibar, VA, Psi), G_NC_down)]
(* \begin{equation}
\mathcal{L}_{\textrm{CC}} =
\mp \frac{g}{2\sqrt2} \sum_i \bar\psi_i \gamma^\mu
(1-\gamma_5)(T^+W^+_\mu+T^-W^-_\mu)\psi_i ,
\end{equation}
where the sign corresponds to $\text{CD}_\pm$, respectively. *)
(*** REVISED: Compatible with CD+. ***)
(* Remark: The definition with the other sign compared to the SM files
comes from the fact that $g_{cc} = 1/(2\sqrt{2})$ is used
overwhelmingly often in the SUSY Feynman rules, so that JR
decided to use a different definiton for [g_cc] in SM and MSSM. *)
(** FB **)
let charged_currents g =
[ ((L (-g), Wm, N g), FBF ((-1), Psibar, VL, Psi), G_CC);
((N (-g), Wp, L g), FBF ((-1), Psibar, VL, Psi), G_CC) ]
(* The quark with the inverted generation (the antiparticle) is the outgoing
one, the other the incoming. The vertex attached to the outgoing up-quark
contains the CKM matrix element {\em not} complex conjugated, while the
vertex with the outgoing down-quark has the conjugated CKM matrix
element. *)
(*** REVISED: Compatible with CD+. FB ***)
let charged_quark_currents g h =
[ ((D (-g), Wm, U h), FBF ((-1), Psibar, VL, Psi), G_CCQ (true,g,h));
((U (-g), Wp, D h), FBF ((-1), Psibar, VL, Psi), G_CCQ (false,h,g))]
(*** REVISED: Compatible with CD+.FB ***)
let charged_chargino_currents n c =
let cc = conj_char c in
[ ((Chargino cc, Wp, Neutralino n),
FBF (1, Psibar, VLR, Chi), G_CWN (c,n));
((Neutralino n, Wm, Chargino c),
FBF (1, Chibar, VLR, Psi), G_NWC (n,c)) ]
(*** REVISED: Compatible with CD+. FB***)
let charged_slepton_currents g m =
[ ((Wm, Slepton (m,-g), Sneutrino g), Vector_Scalar_Scalar (-1), G_SLSNW
(true,g,m));
((Wp, Slepton (m,g), Sneutrino (-g)), Vector_Scalar_Scalar 1, G_SLSNW
(false,g,m)) ]
(*** REVISED: Compatible with CD+. FB***)
let charged_squark_currents' g h m1 m2 =
[ ((Wm, Sup (m1,g), Sdown (m2,-h)), Vector_Scalar_Scalar (-1), G_WSQ
(true,g,h,m1,m2));
((Wp, Sup (m1,-g), Sdown (m2,h)), Vector_Scalar_Scalar 1, G_WSQ
(false,g,h,m1,m2)) ]
let charged_squark_currents g h =
List.flatten (Product.list2 (charged_squark_currents' g h) [M1;M2] [M1;M2] )
(*** REVISED: Compatible with CD+. FB ***)
let neutral_sfermion_currents' g m1 m2 =
[ ((Z, Slepton (m1,-g), Slepton (m2,g)), Vector_Scalar_Scalar (-1),
G_ZSF (SL,g,m1,m2));
((Z, Sup (m1,-g), Sup (m2,g)), Vector_Scalar_Scalar (-1),
G_ZSF(SU,g,m1,m2));
((Z, Sdown (m1,-g), Sdown (m2,g)), Vector_Scalar_Scalar (-1),
G_ZSF (SD,g,m1,m2))]
let neutral_sfermion_currents g =
List.flatten (Product.list2 (neutral_sfermion_currents'
g) [M1;M2] [M1;M2]) @
[ ((Z, Sneutrino (-g), Sneutrino g), Vector_Scalar_Scalar (-1),
G_ZSF (SN,g,M1,M1)) ]
(*** REVISED: Compatible with CD+. FB***)
let neutral_Z (n,m) =
[ ((Neutralino n, Z, Neutralino m), FBF (1, Chibar, VLR, Chi),
(G_NZN (n,m))) ]
(*** REVISED: Compatible with CD+. FB***)
let charged_Z c1 c2 =
let cc1 = conj_char c1 in
((Chargino cc1, Z, Chargino c2), FBF ((-1), Psibar, VA , Psi),
G_CZC (c1,c2))
(*** REVISED: Compatible with CD+.
Remark: This is pure octet. FB***)
let yukawa_v =
[ (Gluino, Gl, Gluino), FBF (1, Chibar, V, Chi), Gs]
(*** REVISED: Independent of the sign of CD. ***)
(*** REVISED: Felix Braam: Compact version using new COMBOS + FF-Couplings *)
let yukawa_higgs_FFS f s =
[((conjugate f, SHiggs s, f ), FBF (1, Psibar, S, Psi),
G_YUK_FFS (conjugate f, f, s))]
let yukawa_higgs_FFP f p =
[((conjugate f, PHiggs p, f), FBF (1, Psibar, P, Psi),
G_YUK_FFP (conjugate f ,f , p))]
let yukawa_higgs_NLC g =
[ ((N (-g), Hp, L g), FBF (1, Psibar, Coupling.SR, Psi), G_YUK_LCN g);
((L (-g), Hm, N g), FBF (1, Psibar, Coupling.SL, Psi), G_YUK_LCN g)]
let yukawa_higgs g =
yukawa_higgs_NLC g @
List.flatten ( Product.list2 yukawa_higgs_FFS [L g; U g; D g] [S1; S2; S3]) @
List.flatten ( Product.list2 yukawa_higgs_FFP [L g; U g; D g] [P1; P2])
(*** REVISED: Independent of the sign of CD. FB***)
let yukawa_higgs_quark (g,h) =
[ ((U (-g), Hp, D h), FBF (1, Psibar, SLR, Psi), G_YUK_UCD (g, h));
((D (-h), Hm, U g), FBF (1, Psibar, SLR, Psi), G_YUK_DCU (g, h)) ]
(*** REVISED: Compatible with CD+. ***)
(*** REVISED: Felix Braam: Compact version using new COMBOS*)
let yukawa_shiggs_2 c1 c2 s =
let cc1 = conj_char c1 in
((Chargino cc1, SHiggs s, Chargino c2), FBF (1, Psibar, SLR, Psi),
G_CSC (c1,c2,s))
let yukawa_phiggs_2 c1 c2 p =
let cc1 = conj_char c1 in
((Chargino cc1, PHiggs p, Chargino c2), FBF (1, Psibar, SLR, Psi),
G_CPC (c1,c2,p))
let yukawa_higgs_2 =
Product.list3 yukawa_shiggs_2 [C1;C2] [C1;C2] [S1;S2;S3] @
Product.list3 yukawa_phiggs_2 [C1;C2] [C1;C2] [P1;P2]
(*** REVISED: Compatible with CD+.FB ***)
let higgs_charg_neutr n c =
let cc = conj_char c in
[ ((Neutralino n, Hm, Chargino c), FBF (-1, Chibar, SLR, Psi),
G_NHC (false,n,c));
((Chargino cc, Hp, Neutralino n), FBF (-1, Psibar, SLR, Chi),
G_NHC (true,n,c)) ]
(*** REVISED: Compatible with CD+. ***)
(*** REVISED: Felix Braam: Compact version using new COMBOS*)
let shiggs_neutr (n,m,s) =
((Neutralino n, SHiggs s, Neutralino m), FBF (1, Chibar, SLR, Chi),
G_CICIS (n,m,s))
let phiggs_neutr (n,m,p) =
((Neutralino n, PHiggs p, Neutralino m), FBF (1, Chibar, SLR, Chi),
G_CICIP (n,m,p))
let higgs_neutr =
List.map shiggs_neutr (two_and_one [N1;N2;N3;N4;N5] [S1;S2;S3]) @
List.map phiggs_neutr (two_and_one [N1;N2;N3;N4;N5] [P1;P2])
(*** REVISED: Compatible with CD+. FB***)
let yukawa_n_2 n m g =
[ ((Neutralino n, Slepton (m,-g), L g), FBF (1, Chibar, SLR, Psi),
G_YUK_N (true,L g,n,SL,m));
((L (-g), Slepton (m,g), Neutralino n), FBF (1, Psibar, SLR, Chi),
G_YUK_N (false,L g,n,SL,m));
((Neutralino n, Sup (m,-g), U g), FBF (1, Chibar, SLR, Psi),
G_YUK_N (true,U g,n,SU,m));
((U (-g), Sup (m,g), Neutralino n), FBF (1, Psibar, SLR, Chi),
G_YUK_N (false,U g,n,SU,m));
((Neutralino n, Sdown (m,-g), D g), FBF (1, Chibar, SLR, Psi),
G_YUK_N (true,D g,n,SD,m));
((D (-g), Sdown (m,g), Neutralino n), FBF (1, Psibar, SLR, Chi),
G_YUK_N (false,D g,n,SD,m)) ]
let yukawa_n_3 n g =
[ ((Neutralino n, Sneutrino (-g), N g), FBF (1, Chibar, SLR, Psi),
G_YUK_N (true,N g,n,SN,M1));
((N (-g), Sneutrino g, Neutralino n), FBF (1, Psibar, SLR, Chi),
G_YUK_N (false,N g, n,SN,M1)) ]
let yukawa_n_5 g m =
[ ((U (-g), Sup (m,g), Gluino), FBF (1, Psibar, SLR, Chi),
G_YUK_G (false,U g,SU,m));
((D (-g), Sdown (m,g), Gluino), FBF (1, Psibar, SLR, Chi),
G_YUK_G (false,D g,SD,m));
((Gluino, Sup (m,-g), U g), FBF (1, Chibar, SLR, Psi),
G_YUK_G (true,U g,SU,m));
((Gluino, Sdown (m,-g), D g), FBF (1, Chibar, SLR, Psi),
G_YUK_G (true,D g,SD,m))]
let yukawa_n =
List.flatten (Product.list3 yukawa_n_2 [N1;N2;N3;N4;N5] [M1;M2] [1;2;3]) @
List.flatten (Product.list2 yukawa_n_3 [N1;N2;N3;N4;N5] [1;2;3]) @
List.flatten (Product.list2 yukawa_n_5 [1;2;3] [M1;M2])
(*** REVISED: Compatible with CD+.FB ***)
let yukawa_c_2 c g =
let cc = conj_char c in
[ ((L (-g), Sneutrino g, Chargino cc), BBB (1, Psibar, SLR,
Psibar), G_YUK_C (true,L g,c,SN,M1));
((Chargino c, Sneutrino (-g), L g), PBP (1, Psi, SLR, Psi),
G_YUK_C (false,L g,c,SN,M1)) ]
let yukawa_c_3 c m g =
let cc = conj_char c in
[ ((N (-g), Slepton (m,g), Chargino c), FBF (1, Psibar, SLR,
Psi), G_YUK_C (true,N g,c,SL,m));
((Chargino cc, Slepton (m,-g), N g), FBF (1, Psibar, SLR,
Psi), G_YUK_C (false,N g,c,SL,m)) ]
let yukawa_c c =
ThoList.flatmap (yukawa_c_2 c) [1;2;3] @
List.flatten (Product.list2 (yukawa_c_3 c) [M1;M2] [1;2;3])
(*** REVISED: Compatible with CD+. FB***)
let yukawa_cq' c (g,h) m =
let cc = conj_char c in
[ ((Chargino c, Sup (m,-g), D h), PBP (1, Psi, SLR, Psi),
G_YUK_Q (false,g,D h,c,SU,m));
((D (-h), Sup (m,g), Chargino cc), BBB (1, Psibar, SLR, Psibar),
G_YUK_Q (true,g,D h,c,SU,m));
((Chargino cc, Sdown (m,-g), U h), FBF (1, Psibar, SLR, Psi),
G_YUK_Q (true,g,U h,c,SD,m));
((U (-h), Sdown (m,g), Chargino c), FBF (1, Psibar, SLR, Psi),
G_YUK_Q (false,g,U h,c,SD,m)) ]
let yukawa_cq c =
if Flags.ckm_present then
List.flatten (Product.list2 (yukawa_cq' c) [(1,1);(1,2);(2,1);(2,2);(1,3);(2,3);(3,3);(3,2);(3,1)] [M1;M2])
else
List.flatten (Product.list2 (yukawa_cq' c) [(1,1);(2,2);(3,3)] [M1;M2])
(*** REVISED: Compatible with CD+.
Remark: Singlet and octet gluon exchange. The coupling is divided by
sqrt(2) to account for the correct normalization of the Lie algebra
generators.
**FB*)
let col_currents g =
[ ((D (-g), Gl, D g), FBF ((-1), Psibar, V, Psi), Gs);
((U (-g), Gl, U g), FBF ((-1), Psibar, V, Psi), Gs)]
(*** REVISED: Compatible with CD+.
Remark: Singlet and octet gluon exchange. The coupling is divided by
sqrt(2) to account for the correct normalization of the Lie algebra
generators.
**FB*)
let chg = function
| M1 -> M2 | M2 -> M1
let col_sfermion_currents g m =
[ ((Gl, Sup (m,-g), Sup (m,g)), Vector_Scalar_Scalar (-1), Gs);
((Gl, Sdown (m,-g), Sdown (m,g)), Vector_Scalar_Scalar (-1), Gs)]
(*** REVISED: Compatible with CD+. **FB*)
let triple_gauge =
[ ((Ga, Wm, Wp), Gauge_Gauge_Gauge 1, I_Q_W);
((Z, Wm, Wp), Gauge_Gauge_Gauge 1, I_G_ZWW);
((Gl, Gl, Gl), Gauge_Gauge_Gauge 1, I_G_S)]
(*** REVISED: Independent of the sign of CD. **FB*)
let gauge4 = Vector4 [(2, C_13_42); (-1, C_12_34); (-1, C_14_23)]
let minus_gauge4 = Vector4 [(-2, C_13_42); (1, C_12_34); (1, C_14_23)]
let quartic_gauge =
[ (Wm, Wp, Wm, Wp), gauge4, G_WWWW;
(Wm, Z, Wp, Z), minus_gauge4, G_ZZWW;
(Wm, Z, Wp, Ga), minus_gauge4, G_PZWW;
(Wm, Ga, Wp, Ga), minus_gauge4, G_PPWW;
(Gl, Gl, Gl, Gl), gauge4, G_SS]
(* The [Scalar_Vector_Vector] couplings do not depend on the choice of the
sign of the covariant derivative since they are quadratic in the
gauge couplings. *)
(*** REVISED: Compatible with CD+. FB***)
(*** Revision: 2005-03-10: first two vertices corrected. ***)
(*** REVISED: Compact version using new COMBOS*)
(*** REVISED: Couplings adjusted to FF-convention*)
let gauge_higgs_WPC p=
[ ((Wm, Hp, PHiggs p), Vector_Scalar_Scalar 1, G_GH_WPC p);
((Wp, Hm, PHiggs p), Vector_Scalar_Scalar 1, G_GH_WPC p)]
let gauge_higgs_WSC s=
[((Wm, Hp, SHiggs s),Vector_Scalar_Scalar 1, G_GH_WSC s);
((Wp, Hm, SHiggs s),Vector_Scalar_Scalar (-1), G_GH_WSC s)]
let gauge_higgs_ZSP s p =
[((Z, SHiggs s, PHiggs p),Vector_Scalar_Scalar 1, G_GH_ZSP (s,p))]
let gauge_higgs_WWS s=
((SHiggs s, Wp, Wm),Scalar_Vector_Vector 1, G_GH_WWS s)
let gauge_higgs_ZZS s=
((SHiggs s, Z, Z), Scalar_Vector_Vector 1, G_GH_ZZS s)
let gauge_higgs_ZCC =
((Z, Hp, Hm),Vector_Scalar_Scalar 1, G_GH_ZCC )
let gauge_higgs_GaCC =
((Ga, Hp, Hm),Vector_Scalar_Scalar 1, G_GH_GaCC )
let gauge_higgs =
ThoList.flatmap gauge_higgs_WPC [P1;P2] @
ThoList.flatmap gauge_higgs_WSC [S1;S2;S3] @
List.flatten (Product.list2 gauge_higgs_ZSP [S1;S2;S3] [P1;P2]) @
List.map gauge_higgs_WWS [S1;S2;S3] @
List.map gauge_higgs_ZZS [S1;S2;S3] @
[gauge_higgs_ZCC] @ [gauge_higgs_GaCC]
(*** REVISED: Compact version using new COMBOS*)
(*** REVISED: Couplings adjusted to FF-convention*)
let gauge_higgs4_ZZPP (p1,p2) =
((PHiggs p1, PHiggs p2, Z, Z), Scalar2_Vector2 1, G_GH4_ZZPP (p1,p2))
let gauge_higgs4_ZZSS (s1,s2) =
((SHiggs s1, SHiggs s2 , Z, Z), Scalar2_Vector2 1, G_GH4_ZZSS (s1,s2))
let gauge_higgs4_ZZCC =
((Hp, Hm, Z, Z), Scalar2_Vector2 1, G_GH4_ZZCC)
let gauge_higgs4_GaGaCC =
((Hp, Hm, Ga, Ga), Scalar2_Vector2 1, G_GH4_GaGaCC)
let gauge_higgs4_ZGaCC =
((Hp, Hm, Ga, Z), Scalar2_Vector2 1, G_GH4_ZGaCC )
let gauge_higgs4_WWCC =
((Hp, Hm, Wp, Wm), Scalar2_Vector2 1, G_GH4_WWCC )
let gauge_higgs4_WWPP (p1,p2) =
((PHiggs p1, PHiggs p2, Wp, Wm), Scalar2_Vector2 1, G_GH4_WWPP (p1,p2))
let gauge_higgs4_WWSS (s1,s2) =
((SHiggs s1, SHiggs s2, Wp, Wm), Scalar2_Vector2 1, G_GH4_WWSS (s1,s2))
let gauge_higgs4_ZWSC s =
[ ((Hp, SHiggs s, Wm, Z), Scalar2_Vector2 1, G_GH4_ZWSC s);
((Hm, SHiggs s, Wp, Z), Scalar2_Vector2 1, G_GH4_ZWSC s)]
let gauge_higgs4_GaWSC s =
[ ((Hp, SHiggs s, Wm, Ga), Scalar2_Vector2 1, G_GH4_GaWSC s);
((Hm, SHiggs s, Wp, Ga), Scalar2_Vector2 1, G_GH4_GaWSC s) ]
let gauge_higgs4_ZWPC p =
[ ((Hp, PHiggs p, Wm, Z), Scalar2_Vector2 1, G_GH4_ZWPC p);
((Hm, PHiggs p, Wp, Z), Scalar2_Vector2 (-1), G_GH4_ZWPC p)]
let gauge_higgs4_GaWPC p =
[ ((Hp, PHiggs p, Wm, Ga), Scalar2_Vector2 1, G_GH4_GaWPC p);
((Hm, PHiggs p, Wp, Ga), Scalar2_Vector2 (-1), G_GH4_GaWPC p) ]
let gauge_higgs4 =
List.map gauge_higgs4_ZZPP (pairs [P1;P2]) @
List.map gauge_higgs4_ZZSS (pairs [S1;S2;S3]) @
[gauge_higgs4_ZZCC] @ [gauge_higgs4_GaGaCC] @
[gauge_higgs4_ZGaCC] @ [gauge_higgs4_WWCC] @
List.map gauge_higgs4_WWPP (pairs [P1;P2]) @
List.map gauge_higgs4_WWSS (pairs [S1;S2;S3]) @
ThoList.flatmap gauge_higgs4_ZWSC [S1;S2;S3] @
ThoList.flatmap gauge_higgs4_GaWSC [S1;S2;S3] @
ThoList.flatmap gauge_higgs4_ZWPC [P1;P2] @
ThoList.flatmap gauge_higgs4_GaWPC [P1;P2]
(**********************************************FB****)
let gauge_sfermion4' g m1 m2 =
[ ((Wp, Wm, Slepton (m1,g), Slepton (m2,-g)), Scalar2_Vector2 1,
G_WWSFSF (SL,g,m1,m2));
((Z, Ga, Slepton (m1,g), Slepton (m2,-g)), Scalar2_Vector2 1,
G_ZPSFSF (SL,g,m1,m2));
((Z, Z, Slepton (m1,g), Slepton (m2,-g)), Scalar2_Vector2 1,
G_ZZSFSF(SL,g,m1,m2));
((Wp, Wm, Sup (m1,g), Sup (m2,-g)), Scalar2_Vector2 1, G_WWSFSF
(SU,g,m1,m2));
((Wp, Wm, Sdown (m1,g), Sdown (m2,-g)), Scalar2_Vector2 1,
G_WWSFSF(SD,g,m1,m2));
((Z, Z, Sup (m1,g), Sup (m2,-g)), Scalar2_Vector2 1, G_ZZSFSF
(SU,g,m1,m2));
((Z, Z, Sdown (m1,g), Sdown (m2,-g)), Scalar2_Vector2 1, G_ZZSFSF
(SD,g,m1,m2));
((Z, Ga, Sup (m1,g), Sup (m2,-g)), Scalar2_Vector2 1, G_ZPSFSF
(SU,g,m1,m2));
((Z, Ga, Sdown (m1,g), Sdown (m2,-g)), Scalar2_Vector2 1, G_ZPSFSF
(SD,g,m1,m2)) ]
let gauge_sfermion4'' g m =
[ ((Wp, Ga, Slepton (m,g), Sneutrino (-g)), Scalar2_Vector2 1,
G_WPSLSN (false,g,m));
((Wm, Ga, Slepton (m,-g), Sneutrino g), Scalar2_Vector2 1,
G_WPSLSN (true,g,m));
((Wp, Z, Slepton (m,g), Sneutrino (-g)), Scalar2_Vector2 1,
G_WZSLSN(false,g,m));
((Wm, Z, Slepton (m,-g), Sneutrino g), Scalar2_Vector2 1,
G_WZSLSN (true,g,m));
((Ga, Ga, Slepton (m,g), Slepton (m,-g)), Scalar2_Vector2 1,
G_PPSFSF SL);
((Ga, Ga, Sup (m,g), Sup (m,-g)), Scalar2_Vector2 1, G_PPSFSF SU);
((Ga, Ga, Sdown (m,g), Sdown (m,-g)), Scalar2_Vector2 1, G_PPSFSF SD)]
let gauge_sfermion4 g =
List.flatten (Product.list2 (gauge_sfermion4' g) [M1;M2] [M1;M2]) @
ThoList.flatmap (gauge_sfermion4'' g) [M1;M2] @
[ ((Wp, Wm, Sneutrino g, Sneutrino (-g)), Scalar2_Vector2 1, G_WWSFSF
(SN,g,M1,M1));
((Z, Z, Sneutrino g, Sneutrino (-g)), Scalar2_Vector2 1, G_ZZSFSF
(SN,g,M1,M1)) ]
(*** Added by Felix Braam. ***)
let gauge_squark4' g h m1 m2 =
[ ((Wp, Ga, Sup (m1,-g), Sdown (m2,h)), Scalar2_Vector2 1, G_WPSUSD
(false,m1,m2,g,h));
((Wm, Ga, Sup (m1,g), Sdown (m2,-h)), Scalar2_Vector2 1, G_WPSUSD
(true,m1,m2,g,h));
((Wp, Z, Sup (m1,-g), Sdown (m2,h)), Scalar2_Vector2 1, G_WZSUSD
(false,m1,m2,g,h));
((Wm, Z, Sup (m1,g), Sdown (m2,-h)), Scalar2_Vector2 1, G_WZSUSD
(true,m1,m2,g,h)) ]
let gauge_squark4 g h = List.flatten (Product.list2 (gauge_squark4' g h)
[M1;M2] [M1;M2])
(**********************************FB*********************)
let gluon_w_squark' g h m1 m2 =
[ ((Gl, Wp, Sup (m1,-g), Sdown (m2,h)),
Scalar2_Vector2 1, G_GlWSUSD (false,m1,m2,g,h));
((Gl, Wm, Sup (m1,g), Sdown (m2,-h)),
Scalar2_Vector2 1, G_GlWSUSD (true,m1,m2,g,h)) ]
let gluon_w_squark g h =
List.flatten (Product.list2 (gluon_w_squark' g h) [M1;M2] [M1;M2])
(***********************************FB********************)
let gluon_gauge_squark' g m1 m2 =
[ ((Gl, Z, Sup (m1,g), Sup (m2,-g)),
Scalar2_Vector2 2, G_GlZSFSF (SU,g,m1,m2));
((Gl, Z, Sdown (m1,g), Sdown (m2,-g)),
Scalar2_Vector2 2, G_GlZSFSF (SD,g,m1,m2)) ]
let gluon_gauge_squark'' g m =
[ ((Gl, Ga, Sup (m,g), Sup (m,-g)), Scalar2_Vector2 2, G_GlPSQSQ);
((Gl, Ga, Sdown (m,g), Sdown (m,-g)), Scalar2_Vector2 (-1), G_GlPSQSQ) ]
let gluon_gauge_squark g =
List.flatten (Product.list2 (gluon_gauge_squark' g) [M1;M2] [M1;M2]) @
ThoList.flatmap (gluon_gauge_squark'' g) [M1;M2]
(*************************************FB******************)
let gluon2_squark2' g m =
[ ((Gl, Gl, Sup (m,g), Sup (m,-g)), Scalar2_Vector2 2, G_GlGlSQSQ);
((Gl, Gl, Sdown (m,g), Sdown (m,-g)), Scalar2_Vector2 2, G_GlGlSQSQ) ]
let gluon2_squark2 g =
ThoList.flatmap (gluon2_squark2' g) [M1;M2]
(*** REVISED: Independent of the sign of CD. *FB**)
(*** REVISED: Compact version using new COMBOS*)
(*** REVISED: Couplings adjusted to FF-convention*)
let higgs_SCC s =
((Hp, Hm, SHiggs s), Scalar_Scalar_Scalar 1, G_H3_SCC s )
let higgs_SSS (s1,s2,s3)=
((SHiggs s1, SHiggs s2, SHiggs s3), Scalar_Scalar_Scalar 1,
G_H3_SSS (s1,s2,s3))
let higgs_SPP (p1,p2,s) =
((SHiggs s, PHiggs p1, PHiggs p2), Scalar_Scalar_Scalar 1,
G_H3_SPP (s,p1,p2))
let higgs =
List.map higgs_SCC [S1;S2;S3]@
List.map higgs_SSS (triples [S1;S2;S3])@
List.map higgs_SPP (two_and_one [P1;P2] [S1;S2;S3])
let higgs4 = []
(* The vertices of the type Higgs - Sfermion - Sfermion are independent of
the choice of the CD sign since they are quadratic in the gauge
coupling. *)
(*** REVISED: Independent of the sign of CD. ***)
let higgs_sneutrino' s g =
((SHiggs s, Sneutrino g, Sneutrino (-g)), Scalar_Scalar_Scalar 1,
G_SFSFS (s,SN,g,M1,M1))
let higgs_sneutrino'' g m =
[((Hp, Sneutrino (-g), Slepton (m,g)), Scalar_Scalar_Scalar 1,
G_HSNSL (false,g,m));
((Hm, Sneutrino g, Slepton (m,-g)), Scalar_Scalar_Scalar 1,
G_HSNSL (true,g,m))]
let higgs_sneutrino =
Product.list2 higgs_sneutrino' [S1;S2;S3] [1;2;3] @
List.flatten ( Product.list2 higgs_sneutrino'' [1;2;3] [M1;M2] )
(* Under the assumption that there is no mixing between the left- and
right-handed sfermions for the first two generations there is only a
coupling of the form Higgs - sfermion1 - sfermion2 for the third
generation. All the others are suppressed by $m_f/M_W$. *)
(*** REVISED: Independent of the sign of CD. ***)
let higgs_sfermion_S s g m1 m2 =
[ ((SHiggs s, Slepton (m1,g), Slepton (m2,-g)), Scalar_Scalar_Scalar 1,
G_SFSFS (s,SL,g,m1,m2));
((SHiggs s, Sup (m1,g), Sup (m2,-g)), Scalar_Scalar_Scalar 1,
G_SFSFS (s,SU,g,m1,m2));
((SHiggs s, Sdown (m1,g), Sdown (m2,-g)), Scalar_Scalar_Scalar 1,
G_SFSFS (s,SD,g,m1,m2))]
let higgs_sfermion' g m1 m2 =
(higgs_sfermion_S S1 g m1 m2) @ (higgs_sfermion_S S2 g m1 m2) @ (higgs_sfermion_S S3 g m1 m2)
let higgs_sfermion_P p g m1 m2 =
[ ((PHiggs p, Slepton (m1,g), Slepton (m2,-g)), Scalar_Scalar_Scalar 1,
G_SFSFP (p,SL,g,m1,m2));
((PHiggs p, Sup (m1,g), Sup (m2,-g)), Scalar_Scalar_Scalar 1,
G_SFSFP (p,SU,g,m1,m2));
((PHiggs p, Sdown (m1,g), Sdown (m2,-g)), Scalar_Scalar_Scalar 1,
G_SFSFP (p,SD,g,m1,m2)) ]
let higgs_sfermion'' g m1 m2 =
(higgs_sfermion_P P1 g m1 m2) @ (higgs_sfermion_P P2 g m1 m2)
let higgs_sfermion = List.flatten (Product.list3 higgs_sfermion' [1;2;3] [M1;M2] [M1;M2]) @
List.flatten (Product.list3 higgs_sfermion'' [1;2;3] [M1;M2] [M1;M2])
(*** REVISED: Independent of the sign of CD. ***)
let higgs_squark' g h m1 m2 =
[ ((Hp, Sup (m1,-g), Sdown (m2,h)), Scalar_Scalar_Scalar 1,
G_HSUSD (false,m1,m2,g,h));
((Hm, Sup (m1,g), Sdown (m2,-h)), Scalar_Scalar_Scalar 1,
G_HSUSD (true,m1,m2,g,h)) ]
let higgs_squark_a g h = higgs_squark' g h M1 M1
let higgs_squark_b (g,h) = List.flatten (Product.list2 (higgs_squark' g h)
[M1;M2] [M1;M2])
let higgs_squark =
List.flatten (Product.list2 higgs_squark_a [1;2] [1;2]) @
ThoList.flatmap higgs_squark_b [(1,3);(2,3);(3,3);(3,1);(3,2)]
let vertices3 =
(ThoList.flatmap electromagnetic_currents_3 [1;2;3] @
ThoList.flatmap electromagnetic_currents_2 [C1;C2] @
List.flatten (Product.list2 electromagnetic_sfermion_currents [1;2;3]
[M1;M2]) @
ThoList.flatmap neutral_currents [1;2;3] @
ThoList.flatmap neutral_sfermion_currents [1;2;3] @
ThoList.flatmap charged_currents [1;2;3] @
List.flatten (Product.list2 charged_slepton_currents [1;2;3]
[M1;M2]) @
(if Flags.ckm_present then
List.flatten (Product.list2 charged_quark_currents [1;2;3]
[1;2;3]) @
List.flatten (Product.list2 charged_squark_currents [1;2;3]
[1;2;3]) @
ThoList.flatmap yukawa_higgs_quark [(1,3);(2,3);(3,3);(3,1);(3,2)]
else
charged_quark_currents 1 1 @
charged_quark_currents 2 2 @
charged_quark_currents 3 3 @
charged_squark_currents 1 1 @
charged_squark_currents 2 2 @
charged_squark_currents 3 3 @
ThoList.flatmap yukawa_higgs_quark [(3,3)]) @
(*i ThoList.flatmap yukawa_higgs [1;2;3] @ i*)
yukawa_higgs 3 @ yukawa_n @
ThoList.flatmap yukawa_c [C1;C2] @
ThoList.flatmap yukawa_cq [C1;C2] @
List.flatten (Product.list2 charged_chargino_currents [N1;N2;N3;N4;N5]
[C1;C2]) @ triple_gauge @
ThoList.flatmap neutral_Z (pairs [N1;N2;N3;N4;N5]) @
Product.list2 charged_Z [C1;C2] [C1;C2] @
gauge_higgs @ higgs @ yukawa_higgs_2 @
(*i List.flatten (Product.list2 yukawa_higgs_quark [1;2;3] [1;2;3]) @ i*)
List.flatten (Product.list2 higgs_charg_neutr [N1;N2;N3;N4;N5] [C1;C2]) @
higgs_neutr @ higgs_sneutrino @ higgs_sfermion @
higgs_squark @ yukawa_v @
ThoList.flatmap col_currents [1;2;3] @
List.flatten (Product.list2 col_sfermion_currents [1;2;3] [M1;M2]))
let vertices4 =
(quartic_gauge @ higgs4 @ gauge_higgs4 @
ThoList.flatmap gauge_sfermion4 [1;2;3] @
List.flatten (Product.list2 gauge_squark4 [1;2;3] [1;2;3]) @
ThoList.flatmap gluon2_squark2 [1;2;3] @
List.flatten (Product.list2 gluon_w_squark [1;2;3] [1;2;3]) @
ThoList.flatmap gluon_gauge_squark [1;2;3])
let vertices () = (vertices3, vertices4, [])
let table = F.of_vertices (vertices ())
let fuse2 = F.fuse2 table
let fuse3 = F.fuse3 table
let fuse = F.fuse table
let max_degree () = 4
(* SLHA2-Nomenclature for neutral Higgses *)
let flavor_of_string s =
match s with
| "e-" -> L 1 | "e+" -> L (-1)
| "mu-" -> L 2 | "mu+" -> L (-2)
| "tau-" -> L 3 | "tau+" -> L (-3)
| "nue" -> N 1 | "nuebar" -> N (-1)
| "numu" -> N 2 | "numubar" -> N (-2)
| "nutau" -> N 3 | "nutaubar" -> N (-3)
| "se1-" -> Slepton (M1,1) | "se1+" -> Slepton (M1,-1)
| "smu1-" -> Slepton (M1,2) | "smu1+" -> Slepton (M1,-2)
| "stau1-" -> Slepton (M1,3) | "stau1+" -> Slepton (M1,-3)
| "se2-" -> Slepton (M2,1) | "se2+" -> Slepton (M2,-1)
| "smu2-" -> Slepton (M2,2) | "smu2+" -> Slepton (M2,-2)
| "stau2-" -> Slepton (M2,3) | "stau2+" -> Slepton (M2,-3)
| "snue" -> Sneutrino 1 | "snue*" -> Sneutrino (-1)
| "snumu" -> Sneutrino 2 | "snumu*" -> Sneutrino (-2)
| "snutau" -> Sneutrino 3 | "snutau*" -> Sneutrino (-3)
| "u" -> U 1 | "ubar" -> U (-1)
| "c" -> U 2 | "cbar" -> U (-2)
| "t" -> U 3 | "tbar" -> U (-3)
| "d" -> D 1 | "dbar" -> D (-1)
| "s" -> D 2 | "sbar" -> D (-2)
| "b" -> D 3 | "bbar" -> D (-3)
| "A" -> Ga | "Z" | "Z0" -> Z
| "W+" -> Wp | "W-" -> Wm
| "gl" | "g" -> Gl
| "h01" -> SHiggs S1 | "h02" -> SHiggs S2 | "h03" -> SHiggs S3
| "A01" -> PHiggs P1 | "A02" -> PHiggs P2
| "H+" -> Hp | "H-" -> Hm
| "su1" -> Sup (M1,1) | "su1c" -> Sup (M1,-1)
| "sc1" -> Sup (M1,2) | "sc1c" -> Sup (M1,-2)
| "st1" -> Sup (M1,3) | "st1c" -> Sup (M1,-3)
| "su2" -> Sup (M2,1) | "su2c" -> Sup (M2,-1)
| "sc2" -> Sup (M2,2) | "sc2c" -> Sup (M2,-2)
| "st2" -> Sup (M2,3) | "st2c" -> Sup (M2,-3)
| "sgl" | "sg" -> Gluino
| "sd1" -> Sdown (M1,1) | "sd1c" -> Sdown (M1,-1)
| "ss1" -> Sdown (M1,2) | "ss1c" -> Sdown (M1,-2)
| "sb1" -> Sdown (M1,3) | "sb1c" -> Sdown (M1,-3)
| "sd2" -> Sdown (M2,1) | "sd2c" -> Sdown (M2,-1)
| "ss2" -> Sdown (M2,2) | "ss2c" -> Sdown (M2,-2)
| "sb2" -> Sdown (M2,3) | "sb2c" -> Sdown (M2,-3)
| "neu1" -> Neutralino N1 | "neu2" -> Neutralino N2
| "neu3" -> Neutralino N3 | "neu4" -> Neutralino N4
| "neu5" -> Neutralino N5
| "ch1+" -> Chargino C1 | "ch2+" -> Chargino C2
| "ch1-" -> Chargino C1c | "ch2-" -> Chargino C2c
| s -> invalid_arg ("Fatal error: %s Modellib_NMSSM.NMSSM.flavor_of_string:" ^ s)
let flavor_to_string = function
| L 1 -> "e-" | L (-1) -> "e+"
| L 2 -> "mu-" | L (-2) -> "mu+"
| L 3 -> "tau-" | L (-3) -> "tau+"
| N 1 -> "nue" | N (-1) -> "nuebar"
| N 2 -> "numu" | N (-2) -> "numubar"
| N 3 -> "nutau" | N (-3) -> "nutaubar"
| U 1 -> "u" | U (-1) -> "ubar"
| U 2 -> "c" | U (-2) -> "cbar"
| U 3 -> "t" | U (-3) -> "tbar"
| U _ -> invalid_arg
"Modellib_NMSSM.NMSSM.flavor_to_string: invalid up type quark"
| D 1 -> "d" | D (-1) -> "dbar"
| D 2 -> "s" | D (-2) -> "sbar"
| D 3 -> "b" | D (-3) -> "bbar"
| D _ -> invalid_arg
"Modellib_NMSSM.NMSSM.flavor_to_string: invalid down type quark"
| Gl -> "gl" | Gluino -> "sgl"
| Ga -> "A" | Z -> "Z"
| Wp -> "W+" | Wm -> "W-"
| SHiggs S1 -> "h01" | SHiggs S2 -> "h02" | SHiggs S3 -> "h03"
| PHiggs P1 -> "A01" | PHiggs P2 -> "A02"
| Hp -> "H+" | Hm -> "H-"
| Slepton (M1,1) -> "se1-" | Slepton (M1,-1) -> "se1+"
| Slepton (M1,2) -> "smu1-" | Slepton (M1,-2) -> "smu1+"
| Slepton (M1,3) -> "stau1-" | Slepton (M1,-3) -> "stau1+"
| Slepton (M2,1) -> "se2-" | Slepton (M2,-1) -> "se2+"
| Slepton (M2,2) -> "smu2-" | Slepton (M2,-2) -> "smu2+"
| Slepton (M2,3) -> "stau2-" | Slepton (M2,-3) -> "stau2+"
| Sneutrino 1 -> "snue" | Sneutrino (-1) -> "snue*"
| Sneutrino 2 -> "snumu" | Sneutrino (-2) -> "snumu*"
| Sneutrino 3 -> "snutau" | Sneutrino (-3) -> "snutau*"
| Sup (M1,1) -> "su1" | Sup (M1,-1) -> "su1c"
| Sup (M1,2) -> "sc1" | Sup (M1,-2) -> "sc1c"
| Sup (M1,3) -> "st1" | Sup (M1,-3) -> "st1c"
| Sup (M2,1) -> "su2" | Sup (M2,-1) -> "su2c"
| Sup (M2,2) -> "sc2" | Sup (M2,-2) -> "sc2c"
| Sup (M2,3) -> "st2" | Sup (M2,-3) -> "st2c"
| Sdown (M1,1) -> "sd1" | Sdown (M1,-1) -> "sd1c"
| Sdown (M1,2) -> "ss1" | Sdown (M1,-2) -> "ss1c"
| Sdown (M1,3) -> "sb1" | Sdown (M1,-3) -> "sb1c"
| Sdown (M2,1) -> "sd2" | Sdown (M2,-1) -> "sd2c"
| Sdown (M2,2) -> "ss2" | Sdown (M2,-2) -> "ss2c"
| Sdown (M2,3) -> "sb2" | Sdown (M2,-3) -> "sb2c"
| Neutralino N1 -> "neu1"
| Neutralino N2 -> "neu2"
| Neutralino N3 -> "neu3"
| Neutralino N4 -> "neu4"
| Neutralino N5 -> "neu5"
| Chargino C1 -> "ch1+" | Chargino C1c -> "ch1-"
| Chargino C2 -> "ch2+" | Chargino C2c -> "ch2-"
| _ -> invalid_arg "Modellib_NMSSM.NMSSM.flavor_to_string"
let flavor_to_TeX = function
| L 1 -> "e^-" | L (-1) -> "e^+"
| L 2 -> "\\mu^-" | L (-2) -> "\\mu^+"
| L 3 -> "\\tau^-" | L (-3) -> "\\tau^+"
| N 1 -> "\\nu_e" | N (-1) -> "\\bar{\\nu}_e"
| N 2 -> "\\nu_\\mu" | N (-2) -> "\\bar{\\nu}_\\mu"
| N 3 -> "\\nu_\\tau" | N (-3) -> "\\bar{\\nu}_\\tau"
| U 1 -> "u" | U (-1) -> "\\bar{u}"
| U 2 -> "c" | U (-2) -> "\\bar{c}"
| U 3 -> "t" | U (-3) -> "\\bar{t}"
| D 1 -> "d" | D (-1) -> "\\bar{d}"
| D 2 -> "s" | D (-2) -> "\\bar{s}"
| D 3 -> "b" | D (-3) -> "\\bar{b}"
| L _ -> invalid_arg
"Modellib_NMSSM.NMSSM.flavor_to_TeX: invalid lepton"
| N _ -> invalid_arg
"Modellib_NMSSM.NMSSM.flavor_to_TeX: invalid neutrino"
| U _ -> invalid_arg
"Modellib_NMSSM.NMSSM.flavor_to_TeX: invalid up type quark"
| D _ -> invalid_arg
"Modellib_NMSSM.NMSSM.flavor_to_TeX: invalid down type quark"
| Gl -> "g" | Gluino -> "\\widetilde{g}"
| Ga -> "\\gamma" | Z -> "Z" | Wp -> "W^+" | Wm -> "W^-"
| SHiggs S1 -> "S_1" | SHiggs S2 -> "S_2" | SHiggs S3 -> "S_3"
| PHiggs P1 -> "P_1" | PHiggs P2 -> "P_2"
| Hp -> "H^+" | Hm -> "H^-"
| Slepton (M1,1) -> "\\widetilde{e}_1^-"
| Slepton (M1,-1) -> "\\widetilde{e}_1^+"
| Slepton (M1,2) -> "\\widetilde{\\mu}_1^-"
| Slepton (M1,-2) -> "\\widetilde{\\mu}_1^+"
| Slepton (M1,3) -> "\\widetilde{\\tau}_1^-"
| Slepton (M1,-3) -> "\\widetilde{\\tau}_1^+"
| Slepton (M2,1) -> "\\widetilde{e}_2^-"
| Slepton (M2,-1) -> "\\widetilde{e}_2^+"
| Slepton (M2,2) -> "\\widetilde{\\mu}_2^-"
| Slepton (M2,-2) -> "\\widetilde{\\mu}_2^+"
| Slepton (M2,3) -> "\\widetilde{\\tau}_2^-"
| Slepton (M2,-3) -> "\\widetilde{\\tau}_2^+"
| Sneutrino 1 -> "\\widetilde{\\nu}_e"
| Sneutrino (-1) -> "\\widetilde{\\nu}_e^*"
| Sneutrino 2 -> "\\widetilde{\\nu}_\\mu"
| Sneutrino (-2) -> "\\widetilde{\\nu}_\\mu^*"
| Sneutrino 3 -> "\\widetilde{\\nu}_\\tau"
| Sneutrino (-3) -> "\\widetilde{\\nu}_\\tau^*"
| Sup (M1,1) -> "\\widetilde{u}_1"
| Sup (M1,-1) -> "\\widetilde{u}_1^*"
| Sup (M1,2) -> "\\widetilde{c}_1"
| Sup (M1,-2) -> "\\widetilde{c}_1^*"
| Sup (M1,3) -> "\\widetilde{t}_1"
| Sup (M1,-3) -> "\\widetilde{t}_1^*"
| Sup (M2,1) -> "\\widetilde{u}_2"
| Sup (M2,-1) -> "\\widetilde{u}_2^*"
| Sup (M2,2) -> "\\widetilde{c}_2"
| Sup (M2,-2) -> "\\widetilde{c}_2^*"
| Sup (M2,3) -> "\\widetilde{t}_2"
| Sup (M2,-3) -> "\\widetilde{t}_2^*"
| Sdown (M1,1) -> "\\widetilde{d}_1"
| Sdown (M1,-1) -> "\\widetilde{d}_1^*"
| Sdown (M1,2) -> "\\widetilde{s}_1"
| Sdown (M1,-2) -> "\\widetilde{s}_1^*"
| Sdown (M1,3) -> "\\widetilde{b}_1"
| Sdown (M1,-3) -> "\\widetilde{b}_1^*"
| Sdown (M2,1) -> "\\widetilde{d}_2"
| Sdown (M2,-1) -> "\\widetilde{d}_2^*"
| Sdown (M2,2) -> "\\widetilde{s}_2"
| Sdown (M2,-2) -> "\\widetilde{s}_2^*"
| Sdown (M2,3) -> "\\widetilde{b}_2"
| Sdown (M2,-3) -> "\\widetilde{b}_2^*"
| Neutralino N1 -> "\\widetilde{\\chi}^0_1"
| Neutralino N2 -> "\\widetilde{\\chi}^0_2"
| Neutralino N3 -> "\\widetilde{\\chi}^0_3"
| Neutralino N4 -> "\\widetilde{\\chi}^0_4"
| Neutralino N5 -> "\\widetilde{\\chi}^0_5"
| Slepton _ -> invalid_arg
"Modellib_NMSSM.NMSSM.flavor_to_TeX: invalid slepton"
| Sneutrino _ -> invalid_arg
"Modellib_NMSSM.NMSSM.flavor_to_TeX: invalid sneutrino"
| Sup _ -> invalid_arg
"Modellib_NMSSM.NMSSM.flavor_to_TeX: invalid up type squark"
| Sdown _ -> invalid_arg
"Modellib_NMSSM.NMSSM.flavor_to_TeX: invalid down type squark"
| Chargino C1 -> "\\widetilde{\\chi}_1^+"
| Chargino C1c -> "\\widetilde{\\chi}_1^-"
| Chargino C2 -> "\\widetilde{\\chi}_2^+"
| Chargino C2c -> "\\widetilde{\\chi}_2^-"
let flavor_symbol = function
| L g when g > 0 -> "l" ^ string_of_int g
| L g -> "l" ^ string_of_int (abs g) ^ "b"
| N g when g > 0 -> "n" ^ string_of_int g
| N g -> "n" ^ string_of_int (abs g) ^ "b"
| U g when g > 0 -> "u" ^ string_of_int g
| U g -> "u" ^ string_of_int (abs g) ^ "b"
| D g when g > 0 -> "d" ^ string_of_int g
| D g -> "d" ^ string_of_int (abs g) ^ "b"
| Gl -> "gl"
| Ga -> "a" | Z -> "z"
| Wp -> "wp" | Wm -> "wm"
| Slepton (M1,g) when g > 0 -> "sl1" ^ string_of_int g
| Slepton (M1,g) -> "sl1c" ^ string_of_int (abs g)
| Slepton (M2,g) when g > 0 -> "sl2" ^ string_of_int g
| Slepton (M2,g) -> "sl2c" ^ string_of_int (abs g)
| Sneutrino g when g > 0 -> "sn" ^ string_of_int g
| Sneutrino g -> "snc" ^ string_of_int (abs g)
| Sup (M1,g) when g > 0 -> "su1" ^ string_of_int g
| Sup (M1,g) -> "su1c" ^ string_of_int (abs g)
| Sup (M2,g) when g > 0 -> "su2" ^ string_of_int g
| Sup (M2,g) -> "su2c" ^ string_of_int (abs g)
| Sdown (M1,g) when g > 0 -> "sd1" ^ string_of_int g
| Sdown (M1,g) -> "sd1c" ^ string_of_int (abs g)
| Sdown (M2,g) when g > 0 -> "sd2" ^ string_of_int g
| Sdown (M2,g) -> "sd2c" ^ string_of_int (abs g)
| Neutralino n -> "neu" ^ (string_of_neu n)
| Chargino c when (int_of_char c) > 0 -> "cp" ^ string_of_char c
| Chargino c -> "cm" ^ string_of_int (abs (int_of_char c))
| Gluino -> "sgl"
| SHiggs s -> "h0" ^ (string_of_shiggs s)
| PHiggs p -> "A0" ^ (string_of_phiggs p)
| Hp -> "hp" | Hm -> "hm"
let pdg = function
| L g when g > 0 -> 9 + 2*g
| L g -> - 9 + 2*g
| N g when g > 0 -> 10 + 2*g
| N g -> - 10 + 2*g
| U g when g > 0 -> 2*g
| U g -> 2*g
| D g when g > 0 -> - 1 + 2*g
| D g -> 1 + 2*g
| Gl -> 21
| Ga -> 22 | Z -> 23
| Wp -> 24 | Wm -> (-24)
| SHiggs S1 -> 25 | SHiggs S2 -> 35 | SHiggs S3 -> 45
| PHiggs P1 -> 36 | PHiggs P2 -> 46
| Hp -> 37 | Hm -> (-37)
| Slepton (M1,g) when g > 0 -> 1000009 + 2*g
| Slepton (M1,g) -> - 1000009 + 2*g
| Slepton (M2,g) when g > 0 -> 2000009 + 2*g
| Slepton (M2,g) -> - 2000009 + 2*g
| Sneutrino g when g > 0 -> 1000010 + 2*g
| Sneutrino g -> - 1000010 + 2*g
| Sup (M1,g) when g > 0 -> 1000000 + 2*g
| Sup (M1,g) -> - 1000000 + 2*g
| Sup (M2,g) when g > 0 -> 2000000 + 2*g
| Sup (M2,g) -> - 2000000 + 2*g
| Sdown (M1,g) when g > 0 -> 999999 + 2*g
| Sdown (M1,g) -> - 999999 + 2*g
| Sdown (M2,g) when g > 0 -> 1999999 + 2*g
| Sdown (M2,g) -> - 1999999 + 2*g
| Gluino -> 1000021
| Chargino C1 -> 1000024 | Chargino C1c -> (-1000024)
| Chargino C2 -> 1000037 | Chargino C2c -> (-1000037)
| Neutralino N1 -> 1000022 | Neutralino N2 -> 1000023
| Neutralino N3 -> 1000025 | Neutralino N4 -> 1000035
| Neutralino N5 -> 1000045
(* We must take care of the pdg numbers for the two different kinds of
sfermions in the MSSM. The particle data group in its Monte Carlo particle
numbering scheme takes only into account mixtures of the third generation
squarks and the stau. For the other sfermions we will use the number of the
lefthanded field for the lighter mixed state and the one for the righthanded
for the heavier. Below are the official pdg numbers from the Particle
Data Group. In order not to produce arrays with some million entries in
the Fortran code for the masses and the widths we introduce our private
pdg numbering scheme which only extends not too far beyond 42.
Our private scheme then has the following pdf numbers (for the sparticles
the subscripts $L/R$ and $1/2$ are taken synonymously):
\begin{center}
\renewcommand{\arraystretch}{1.2}
\begin{tabular}{|r|l|l|}\hline
$d$ & down-quark & 1 \\\hline
$u$ & up-quark & 2 \\\hline
$s$ & strange-quark & 3 \\\hline
$c$ & charm-quark & 4 \\\hline
$b$ & bottom-quark & 5 \\\hline
$t$ & top-quark & 6 \\\hline\hline
$e^-$ & electron & 11 \\\hline
$\nu_e$ & electron-neutrino & 12 \\\hline
$\mu^-$ & muon & 13 \\\hline
$\nu_\mu$ & muon-neutrino & 14 \\\hline
$\tau^-$ & tau & 15 \\\hline
$\nu_\tau$ & tau-neutrino & 16 \\\hline\hline
$g$ & gluon & (9) 21 \\\hline
$\gamma$ & photon & 22 \\\hline
$Z^0$ & Z-boson & 23 \\\hline
$W^+$ & W-boson & 24 \\\hline\hline
$h^0$ & light Higgs boson & 25 \\\hline
$H^0$ & heavy Higgs boson & 35 \\\hline
$A^0$ & pseudoscalar Higgs & 36 \\\hline
$H^+$ & charged Higgs & 37 \\\hline\hline
$\tilde{d}_L$ & down-squark 1 & 41 \\\hline
$\tilde{u}_L$ & up-squark 1 & 42 \\\hline
$\tilde{s}_L$ & strange-squark 1 & 43 \\\hline
$\tilde{c}_L$ & charm-squark 1 & 44 \\\hline
$\tilde{b}_L$ & bottom-squark 1 & 45 \\\hline
$\tilde{t}_L$ & top-squark 1 & 46 \\\hline
$\tilde{d}_R$ & down-squark 2 & 47 \\\hline
$\tilde{u}_R$ & up-squark 2 & 48 \\\hline
$\tilde{s}_R$ & strange-squark 2 & 49 \\\hline
$\tilde{c}_R$ & charm-squark 2 & 50 \\\hline
$\tilde{b}_R$ & bottom-squark 2 & 51 \\\hline
$\tilde{t}_R$ & top-squark 2 & 52 \\\hline\hline
$\tilde{e}_L$ & selectron 1 & 53 \\\hline
$\tilde{\nu}_{e,L}$ & electron-sneutrino & 54 \\\hline
$\tilde{\mu}_L$ & smuon 1 & 55 \\\hline
$\tilde{\nu}_{\mu,L}$ & muon-sneutrino & 56 \\\hline
$\tilde{\tau}_L$ & stau 1 & 57 \\\hline
$\tilde{\nu}_{\tau,L}$ & tau-sneutrino & 58 \\\hline
$\tilde{e}_R$ & selectron 2 & 59 \\\hline
$\tilde{\mu}_R$ & smuon 2 & 61 \\\hline
$\tilde{\tau}_R$ & stau 2 & 63 \\\hline\hline
$\tilde{g}$ & gluino & 64 \\\hline
$\tilde{\chi}^0_1$ & neutralino 1 & 65 \\\hline
$\tilde{\chi}^0_2$ & neutralino 2 & 66 \\\hline
$\tilde{\chi}^0_3$ & neutralino 3 & 67 \\\hline
$\tilde{\chi}^0_4$ & neutralino 4 & 68 \\\hline
$\tilde{\chi}^0_5$ & neutralino 5 & 69 \\\hline
$\tilde{\chi4}^+_1$ & chargino 1 & 70 \\\hline
$\tilde{\chi}^+_2$ & chargino 2 & 71 \\\hline\hline
$a$ & pseudoscalar & 72 \\\hline
$s$ & scalar singlet & 73 \\\hline
$\tilde{G}$ & gravitino & -- \\\hline\hline
\end{tabular}
\end{center} *)
let pdg_mw = function
| L g when g > 0 -> 9 + 2*g
| L g -> - 9 + 2*g
| N g when g > 0 -> 10 + 2*g
| N g -> - 10 + 2*g
| U g when g > 0 -> 2*g
| U g -> 2*g
| D g when g > 0 -> - 1 + 2*g
| D g -> 1 + 2*g
| Gl -> 21
| Ga -> 22 | Z -> 23
| Wp -> 24 | Wm -> (-24)
| SHiggs S1 -> 25 | SHiggs S2 -> 35 | PHiggs P1 -> 36
| Hp -> 37 | Hm -> (-37)
| Sup (M1,g) when g > 0 -> 40 + 2*g
| Sup (M1,g) -> - 40 + 2*g
| Sup (M2,g) when g > 0 -> 46 + 2*g
| Sup (M2,g) -> - 46 + 2*g
| Sdown (M1,g) when g > 0 -> 39 + 2*g
| Sdown (M1,g) -> - 39 + 2*g
| Sdown (M2,g) when g > 0 -> 45 + 2*g
| Sdown (M2,g) -> - 45 + 2*g
| Slepton (M1,g) when g > 0 -> 51 + 2*g
| Slepton (M1,g) -> - 51 + 2*g
| Slepton (M2,g) when g > 0 -> 57 + 2*g
| Slepton (M2,g) -> - 57 + 2*g
| Sneutrino g when g > 0 -> 52 + 2*g
| Sneutrino g -> - 52 + 2*g
| Gluino -> 64
| Chargino C1 -> 70 | Chargino C1c -> (-70)
| Chargino C2 -> 71 | Chargino C2c -> (-71)
| Neutralino N1 -> 65 | Neutralino N2 -> 66
| Neutralino N3 -> 67 | Neutralino N4 -> 68
| Neutralino N5 -> 69
| PHiggs P2 -> 72 | SHiggs S3 -> 73
let mass_symbol f =
"mass(" ^ string_of_int (abs (pdg_mw f)) ^ ")"
let width_symbol f =
"width(" ^ string_of_int (abs (pdg_mw f)) ^ ")"
let conj_symbol = function
| false, str -> str
| true, str -> str ^ "_c"
let constant_symbol = function
| E -> "e" | G -> "g"
| Mu -> "mu" | Lambda -> "lambda" | G_Z -> "gz"
| Q_lepton -> "qlep" | Q_up -> "qup" | Q_down -> "qdwn"
| Q_charg -> "qchar"
| G_NC_lepton -> "gnclep" | G_NC_neutrino -> "gncneu"
| G_NC_up -> "gncup" | G_NC_down -> "gncdwn"
| G_CC -> "gcc"
| G_CCQ (vc,g1,g2) -> conj_symbol (vc, "g_ccq" ) ^ "(" ^
string_of_int g1 ^ "," ^ string_of_int g2 ^ ")"
| I_Q_W -> "iqw" | I_G_ZWW -> "igzww"
| G_WWWW -> "gw4" | G_ZZWW -> "gzzww"
| G_PZWW -> "gpzww" | G_PPWW -> "gppww"
| G_GH4_ZZPP (p1,p2) -> "g_ZZA0A0(" ^ string_of_phiggs p1 ^ ","
^ string_of_phiggs p2 ^ ")"
| G_GH4_ZZSS (s1,s2) -> "g_ZZh0h0(" ^ string_of_shiggs s1 ^ ","
^ string_of_shiggs s2 ^ ")"
| G_GH4_ZZCC -> "g_zzhphm"
| G_GH4_GaGaCC -> "g_AAhphm"
| G_GH4_ZGaCC -> "g_zAhphm"
| G_GH4_WWCC -> "g_wwhphm"
| G_GH4_WWPP (p1,p2) -> "g_WWA0A0(" ^ string_of_phiggs p1 ^ "," ^
string_of_phiggs p2 ^ ")"
| G_GH4_WWSS (s1,s2) -> "g_WWh0h0(" ^ string_of_shiggs s1 ^ "," ^
string_of_shiggs s2 ^ ")"
| G_GH4_ZWSC s -> "g_ZWhph0(" ^ string_of_shiggs s ^")"
| G_GH4_GaWSC s -> "g_AWhph0(" ^ string_of_shiggs s ^")"
| G_GH4_ZWPC p -> "g_ZWhpA0(" ^ string_of_phiggs p ^")"
| G_GH4_GaWPC p -> "g_AWhpA0(" ^ string_of_phiggs p ^")"
| G_CICIS (n1,n2,s) -> "g_neuneuh0(" ^ string_of_neu n1 ^ "," ^
string_of_neu n2 ^ "," ^ string_of_shiggs s ^ ")"
| G_CICIP (n1,n2,p) -> "g_neuneuA0(" ^ string_of_neu n1 ^ "," ^
string_of_neu n2 ^ "," ^ string_of_phiggs p ^ ")"
| G_H3_SCC s -> "g_h0hphm(" ^ string_of_shiggs s ^ ")"
| G_H3_SPP (s,p1,p2) -> "g_h0A0A0(" ^ string_of_shiggs s ^ "," ^
string_of_phiggs p1 ^ "," ^ string_of_phiggs p2 ^ ")"
| G_H3_SSS (s1,s2,s3) -> "g_h0h0h0(" ^ string_of_shiggs s1 ^ "," ^
string_of_shiggs s2 ^ "," ^ string_of_shiggs s3 ^ ")"
| G_CSC (c1,c2,s) -> "g_chchh0(" ^ string_of_char c1 ^ "," ^
string_of_char c2 ^ "," ^ string_of_shiggs s ^")"
| G_CPC (c1,c2,p) -> "g_chchA0(" ^ string_of_char c1 ^ "," ^
string_of_char c2 ^ "," ^ string_of_phiggs p ^")"
| G_YUK_FFS (f1,f2,s) -> "g_yuk_h0_" ^ string_of_fermion_type f1 ^
string_of_fermion_type f2 ^ "(" ^ string_of_shiggs s ^ "," ^
string_of_fermion_gen f1 ^ ")"
| G_YUK_FFP (f1,f2,p) -> "g_yuk_A0_" ^ string_of_fermion_type f1 ^
string_of_fermion_type f2 ^ "(" ^ string_of_phiggs p ^ "," ^
string_of_fermion_gen f1 ^ ")"
| G_YUK_LCN g -> "g_yuk_hp_ln(" ^ string_of_int g ^ ")"
| G_NWC (n,c) -> "g_nwc(" ^ string_of_char c ^ "," ^ string_of_neu n
^ ")"
| G_CWN (c,n) -> "g_cwn(" ^ string_of_char c ^ "," ^ string_of_neu n
^ ")"
| G_SLSNW (vc,g,m) -> conj_symbol (vc, "g_wslsn") ^ "(" ^
string_of_int g ^ "," ^ string_of_sfm m ^ ")"
| G_NZN (n1,n2) -> "g_zneuneu(" ^ string_of_neu n1 ^ ","
^ string_of_neu n2 ^ ")"
| G_CZC (c1,c2) -> "g_zchch(" ^ string_of_char c1 ^ "," ^
string_of_char c2 ^ ")"
| Gs -> "gs"
| G_YUK_UCD (n,m) -> "g_yuk_hp_ud(" ^ string_of_int n ^ "," ^
string_of_int m ^ ")"
| G_YUK_DCU (n,m) -> "g_yuk_hm_du(" ^ string_of_int n ^ "," ^
string_of_int m ^ ")"
| G_YUK_N (vc,f,n,sf,m) -> conj_symbol (vc, "g_yuk_neu_" ^
string_of_fermion_type f ^ string_of_sff sf) ^ "(" ^
string_of_fermion_gen f ^ "," ^ string_of_neu n ^ "," ^
string_of_sfm m ^ ")"
| G_YUK_G (vc,f,sf,m) -> conj_symbol (vc, "g_yuk_gluino_" ^
string_of_fermion_type f ^ string_of_sff sf) ^ "(" ^
string_of_fermion_gen f ^ "," ^ string_of_sfm m ^ ")"
| G_YUK_C (vc,f,c,sf,m) -> conj_symbol (vc, "g_yuk_char_" ^
string_of_fermion_type f ^ string_of_sff sf) ^ "(" ^
string_of_fermion_gen f ^ "," ^ string_of_char c ^ "," ^
string_of_sfm m ^ ")"
| G_YUK_Q (vc,g1,f,c,sf,m) -> conj_symbol (vc, "g_yuk_char_" ^
string_of_fermion_type f ^ string_of_sff sf) ^ "(" ^ string_of_int
g1 ^ "," ^ string_of_fermion_gen f ^ "," ^ string_of_char c ^ ","
^ string_of_sfm m ^ ")"
| G_WPSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "g_wA_susd") ^ "(" ^
string_of_int g1 ^ "," ^ string_of_int g2 ^ "," ^ string_of_sfm m1 ^
"," ^ string_of_sfm m2 ^ ")"
| G_WZSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "g_wz_susd") ^ "(" ^
string_of_int g1 ^ "," ^ string_of_int g2 ^ "," ^ string_of_sfm m1 ^
"," ^ string_of_sfm m2 ^ ")"
| G_GH_ZSP (s,p) -> "g_zh0a0(" ^ string_of_shiggs s ^ "," ^
string_of_phiggs p ^ ")"
| G_GH_WSC s -> "g_Whph0(" ^ string_of_shiggs s ^ ")"
| G_GH_WPC p -> "g_WhpA0(" ^ string_of_phiggs p ^ ")"
| G_GH_ZZS s -> "g_ZZh0(" ^ string_of_shiggs s ^ ")"
| G_GH_WWS s -> "g_WWh0(" ^ string_of_shiggs s ^ ")"
| G_GH_ZCC -> "g_Zhmhp"
| G_GH_GaCC -> "g_Ahmhp"
| G_ZSF (f,g,m1,m2) -> "g_z" ^ string_of_sff f ^ string_of_sff f ^ "(" ^
string_of_int g ^ "," ^ string_of_sfm m1 ^ "," ^ string_of_sfm m2
^ ")"
| G_HSNSL (vc,g,m) -> conj_symbol (vc, "g_hp_sl" ^ string_of_sfm m ^
"sn1") ^ "(" ^ string_of_int g ^ ")"
| G_GlGlSQSQ -> "g_gg_sqsq"
| G_PPSFSF f -> "g_AA_" ^ string_of_sff f ^ string_of_sff f
| G_ZZSFSF (f,g,m1,m2) -> "g_zz_" ^ string_of_sff f ^ string_of_sff f ^
"(" ^ string_of_int g ^","^ string_of_sfm m1
^ "," ^ string_of_sfm m2 ^ ")"
| G_ZPSFSF (f,g,m1,m2) -> "g_zA_" ^ string_of_sff f ^ string_of_sff f ^
"(" ^ string_of_int g ^","^ string_of_sfm m1
^ "," ^ string_of_sfm m2 ^ ")"
| G_GlPSQSQ -> "g_gA_sqsq"
| G_GlZSFSF (f,g,m1,m2) -> "g_gz_" ^ string_of_sff f ^ string_of_sff f ^
"(" ^ string_of_int g ^ "," ^ string_of_sfm m1 ^ "," ^ string_of_sfm
m2 ^ ")"
| G_GlWSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "g_gw_susd") ^ "(" ^
string_of_int g1 ^ "," ^ string_of_int g2 ^ "," ^ string_of_sfm m1 ^
"," ^ string_of_sfm m2 ^ ")"
| G_SS -> "gs**2"
| I_G_S -> "igs"
| G_NHC (vc,n,c) -> conj_symbol(vc,"g_neuhmchar") ^ "(" ^
string_of_neu n ^ "," ^ string_of_char c ^")"
| G_WWSFSF (f,g,m1,m2) -> "g_ww_" ^ string_of_sff f
^ string_of_sff f ^"(" ^ string_of_int g ^ "," ^ string_of_sfm m1 ^
"," ^ string_of_sfm m2 ^ ")"
| G_WPSLSN (vc,g,m) -> conj_symbol (vc, "g_wA_slsn") ^ "(" ^
string_of_int g ^ "," ^ string_of_sfm m ^ ")"
| G_WZSLSN (vc,g,m) -> conj_symbol (vc, "g_wz_slsn") ^"("^ string_of_int
g ^ "," ^ string_of_sfm m ^ ")"
| G_SFSFS (s,f,g,m1,m2) -> "g_h0_"^ string_of_sff f ^ string_of_sfm m1
^ string_of_sff f ^ string_of_sfm m2 ^ "(" ^ string_of_shiggs s ^ ","
^ string_of_int g ^ ")"
| G_SFSFP (p,f,g,m1,m2) -> "g_A0_"^ string_of_sff f ^ string_of_sfm m1
^ string_of_sff f ^ string_of_sfm m2 ^ "(" ^ string_of_phiggs p ^ ","
^ string_of_int g ^ ")"
| G_HSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "g_hp_su" ^ string_of_sfm
m1 ^ "sd" ^ string_of_sfm m2 )^ "(" ^ string_of_int g1 ^ ","
^ string_of_int g2 ^")"
| G_WSQ (vc,g1,g2,m1,m2) -> conj_symbol (vc, "g_wsusd") ^ "("
^ string_of_int g1 ^ "," ^ string_of_int g2 ^ "," ^ string_of_sfm m1
^ "," ^ string_of_sfm m2 ^ ")"
end
(*i
* Local Variables:
* mode:caml
* indent-tabs-mode:nil
* page-delimiter:"^(\\* .*\n"
* End:
i*)
Index: trunk/src/omega/src/modellib_NMSSM.mli
===================================================================
--- trunk/src/omega/src/modellib_NMSSM.mli (revision 2698)
+++ trunk/src/omega/src/modellib_NMSSM.mli (revision 2699)
@@ -1,46 +1,46 @@
(* $Id$
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. *)
(* \thocwmodulesection{Extended Supersymmetric Models} *)
(* We do not introduce the possibility here of using four point couplings
or not. We simply add the relevant and leave the rest out. No
possibility for Goldstone bosons is given. But we allow for CKM mixing.
*)
module type NMSSM_flags =
sig
val ckm_present : bool
end
module NMSSM : NMSSM_flags
module NMSSM_CKM : NMSSM_flags
-module NMSSM_func : functor (F: NMSSM_flags) -> Model.T with module Ch = Charges.Null
+module NMSSM_func : functor (F: NMSSM_flags) -> Model.T with module Ch = Charges.QQ
(*i
* Local Variables:
* mode:caml
* indent-tabs-mode:nil
* page-delimiter:"^(\\* .*\n"
* End:
i*)
Index: trunk/src/omega/src/modellib_SM.ml
===================================================================
--- trunk/src/omega/src/modellib_SM.ml (revision 2698)
+++ trunk/src/omega/src/modellib_SM.ml (revision 2699)
@@ -1,3003 +1,3046 @@
(* $Id$
- Copyright (C) 1999-2009 by
+ Copyright (C) 1999-2010 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. *)
let rcs_file = RCS.parse "Modellib_SM" ["Lagragians"]
{ RCS.revision = "$Revision$";
RCS.date = "$Date$";
RCS.author = "$Author$";
RCS.source
= "$URL$" }
(* \thocwmodulesection{$\phi^3$} *)
module Phi3 =
struct
let rcs = RCS.rename rcs_file "Modellib.Phi3"
["phi**3 with a single flavor"]
open Coupling
let options = Options.empty
type flavor = Phi
let external_flavors () = [ "", [Phi]]
let flavors () = ThoList.flatmap snd (external_flavors ())
type gauge = unit
type constant = G
let lorentz _ = Scalar
let color _ = Color.Singlet
let propagator _ = Prop_Scalar
let width _ = Timelike
let goldstone _ = None
let conjugate f = f
let fermion _ = 0
module Ch = Charges.Null
let charges _ = ()
module F = Modeltools.Fusions (struct
type f = flavor
type c = constant
let compare = compare
let conjugate = conjugate
end)
let vertices () =
([(Phi, Phi, Phi), Scalar_Scalar_Scalar 1, G], [], [])
let table = F.of_vertices (vertices ())
let fuse2 = F.fuse2 table
let fuse3 = F.fuse3 table
let fuse = F.fuse table
let max_degree () = 3
let parameters () = { input = [G, 1.0]; derived = []; derived_arrays = [] }
let flavor_of_string = function
| "p" -> Phi
| _ -> invalid_arg "Modellib.Phi3.flavor_of_string"
let flavor_to_string Phi = "phi"
let flavor_to_TeX Phi = "\\phi"
let flavor_symbol Phi = "phi"
let gauge_symbol () =
failwith "Modellib.Phi3.gauge_symbol: internal error"
let pdg _ = 1
let mass_symbol _ = "m"
let width_symbol _ = "w"
let constant_symbol G = "g"
end
(* \thocwmodulesection{$\lambda_3\phi^3+\lambda_4\phi^4$} *)
module Phi4 =
struct
let rcs = RCS.rename rcs_file "Modellib.Phi4"
["phi**4 with a single flavor"]
open Coupling
let options = Options.empty
type flavor = Phi
let external_flavors () = [ "", [Phi]]
let flavors () = ThoList.flatmap snd (external_flavors ())
type gauge = unit
type constant = G3 | G4
let lorentz _ = Scalar
let color _ = Color.Singlet
let propagator _ = Prop_Scalar
let width _ = Timelike
let goldstone _ = None
let conjugate f = f
let fermion _ = 0
module Ch = Charges.Null
let charges _ = ()
module F = Modeltools.Fusions (struct
type f = flavor
type c = constant
let compare = compare
let conjugate = conjugate
end)
let vertices () =
([(Phi, Phi, Phi), Scalar_Scalar_Scalar 1, G3],
[(Phi, Phi, Phi, Phi), Scalar4 1, G4], [])
let fuse2 _ = failwith "Modellib.Phi4.fuse2"
let fuse3 _ = failwith "Modellib.Phi4.fuse3"
let fuse = function
| [] | [_] -> invalid_arg "Modellib.Phi4.fuse"
| [_; _] -> [Phi, V3 (Scalar_Scalar_Scalar 1, F23, G3)]
| [_; _; _] -> [Phi, V4 (Scalar4 1, F234, G4)]
| _ -> []
let max_degree () = 4
let parameters () =
{ input = [G3, 1.0; G4, 1.0]; derived = []; derived_arrays = [] }
let flavor_of_string = function
| "p" -> Phi
| _ -> invalid_arg "Modellib.Phi4.flavor_of_string"
let flavor_to_string Phi = "phi"
let flavor_to_TeX Phi = "\\phi"
let flavor_symbol Phi = "phi"
let gauge_symbol () =
failwith "Modellib.Phi4.gauge_symbol: internal error"
let pdg _ = 1
let mass_symbol _ = "m"
let width_symbol _ = "w"
let constant_symbol = function
| G3 -> "g3"
| G4 -> "g4"
end
(* \thocwmodulesection{Quantum Electro Dynamics} *)
module QED =
struct
let rcs = RCS.rename rcs_file "Modellib.QED"
["QED with two leptonic flavors"]
open Coupling
let options = Options.empty
type flavor =
| Electron | Positron
| Muon | AntiMuon
| Tau | AntiTau
| Photon
let external_flavors () =
[ "Leptons", [Electron; Positron; Muon; AntiMuon; Tau; AntiTau];
"Gauge Bosons", [Photon] ]
let flavors () = ThoList.flatmap snd (external_flavors ())
type gauge = unit
type constant = Q
let lorentz = function
| Electron | Muon | Tau -> Spinor
| Positron | AntiMuon | AntiTau -> ConjSpinor
| Photon -> Vector
let color _ = Color.Singlet
let propagator = function
| Electron | Muon | Tau -> Prop_Spinor
| Positron | AntiMuon | AntiTau -> Prop_ConjSpinor
| Photon -> Prop_Feynman
let width _ = Timelike
let goldstone _ =
None
let conjugate = function
| Electron -> Positron | Positron -> Electron
| Muon -> AntiMuon | AntiMuon -> Muon
| Tau -> AntiTau | AntiTau -> Tau
| Photon -> Photon
let fermion = function
| Electron | Muon | Tau -> 1
| Positron | AntiMuon | AntiTau -> -1
| Photon -> 0
- module Ch = Charges.Z
+(* Taking generation numbers makes electric charge redundant. *)
+
+ module Ch = Charges.ZZ
let charges = function
- | Electron | Muon | Tau -> 1
- | Positron | AntiMuon | AntiTau -> -1
- | Photon -> 0
+ | Electron -> [1; 0; 0]
+ | Muon -> [0; 1; 0]
+ | Tau -> [0; 0; 1]
+ | Positron -> [-1;0; 0]
+ | AntiMuon -> [0;-1; 0]
+ | AntiTau -> [0; 0;-1]
+ | Photon -> [0; 0; 0]
module F = Modeltools.Fusions (struct
type f = flavor
type c = constant
let compare = compare
let conjugate = conjugate
end)
let vertices () =
([(Positron, Photon, Electron), FBF (1, Psibar, V, Psi), Q;
(AntiMuon, Photon, Muon), FBF (1, Psibar, V, Psi), Q;
(AntiTau, Photon, Tau), FBF (1, Psibar, V, Psi), Q], [], [])
let table = F.of_vertices (vertices ())
let fuse2 = F.fuse2 table
let fuse3 = F.fuse3 table
let fuse = F.fuse table
let max_degree () = 3
let parameters () = { input = [Q, 1.0]; derived = []; derived_arrays = [] }
let flavor_of_string = function
| "e-" -> Electron | "e+" -> Positron
| "m-" -> Muon | "m+" -> AntiMuon
| "t-" -> Tau | "t+" -> AntiTau
| "A" -> Photon
| _ -> invalid_arg "Modellib.QED.flavor_of_string"
let flavor_to_string = function
| Electron -> "e-" | Positron -> "e+"
| Muon -> "m-" | AntiMuon -> "m+"
| Tau -> "t-" | AntiTau -> "t+"
| Photon -> "A"
let flavor_to_TeX = function
| Electron -> "e^-" | Positron -> "e^+"
| Muon -> "\\mu^-" | AntiMuon -> "\\mu^+"
| Tau -> "^\\tau^-" | AntiTau -> "\\tau+^"
| Photon -> "\\gamma"
let flavor_symbol = function
| Electron -> "ele" | Positron -> "pos"
| Muon -> "muo" | AntiMuon -> "amu"
| Tau -> "tau" | AntiTau -> "ata"
| Photon -> "gam"
let gauge_symbol () =
failwith "Modellib.QED.gauge_symbol: internal error"
let pdg = function
| Electron -> 11 | Positron -> -11
| Muon -> 13 | AntiMuon -> -13
| Tau -> 15 | AntiTau -> -15
| Photon -> 22
let mass_symbol f =
"mass(" ^ string_of_int (abs (pdg f)) ^ ")"
let width_symbol f =
"width(" ^ string_of_int (abs (pdg f)) ^ ")"
let constant_symbol = function
| Q -> "qlep"
end
(* \thocwmodulesection{Quantum Chromo Dynamics} *)
module QCD =
struct
let rcs = RCS.rename rcs_file "Modellib.QCD"
["QCD"]
open Coupling
let options = Options.empty
type flavor =
| U | Ubar | D | Dbar
| C | Cbar | S | Sbar
| T | Tbar | B | Bbar
| Gl
let external_flavors () =
[ "Quarks", [U; D; C; S; T; B; Ubar; Dbar; Cbar; Sbar; Tbar; Bbar];
"Gauge Bosons", [Gl]]
let flavors () = ThoList.flatmap snd (external_flavors ())
type gauge = unit
type constant = Gs | G2 | I_Gs
let lorentz = function
| U | D | C | S | T | B -> Spinor
| Ubar | Dbar | Cbar | Sbar | Tbar | Bbar -> ConjSpinor
| Gl -> Vector
let color = function
| U | D | C | S | T | B -> Color.SUN 3
| Ubar | Dbar | Cbar | Sbar | Tbar | Bbar -> Color.SUN (-3)
| Gl -> Color.AdjSUN 3
let propagator = function
| U | D | C | S | T | B -> Prop_Spinor
| Ubar | Dbar | Cbar | Sbar | Tbar | Bbar -> Prop_ConjSpinor
| Gl -> Prop_Feynman
let width _ = Timelike
let goldstone _ =
None
let conjugate = function
| U -> Ubar
| D -> Dbar
| C -> Cbar
| S -> Sbar
| T -> Tbar
| B -> Bbar
| Ubar -> U
| Dbar -> D
| Cbar -> C
| Sbar -> S
| Tbar -> T
| Bbar -> B
| Gl -> Gl
let fermion = function
| U | D | C | S | T | B -> 1
| Ubar | Dbar | Cbar | Sbar | Tbar | Bbar -> -1
| Gl -> 0
module Ch = Charges.ZZ
let charges = function
| D -> [1; 0; 0; 0; 0; 0]
| U -> [0; 1; 0; 0; 0; 0]
| S -> [0; 0; 1; 0; 0; 0]
| C -> [0; 0; 0; 1; 0; 0]
| B -> [0; 0; 0; 0; 1; 0]
| T -> [0; 0; 0; 0; 0; 1]
| Dbar -> [-1; 0; 0; 0; 0; 0]
| Ubar -> [0; -1; 0; 0; 0; 0]
| Sbar -> [0; 0; -1; 0; 0; 0]
| Cbar -> [0; 0; 0; -1; 0; 0]
| Bbar -> [0; 0; 0; 0; -1; 0]
| Tbar -> [0; 0; 0; 0; 0; -1]
| Gl -> [0; 0; 0; 0; 0; 0]
module F = Modeltools.Fusions (struct
type f = flavor
type c = constant
let compare = compare
let conjugate = conjugate
end)
(* This is compatible with CD+. *)
let color_current =
[ ((Dbar, Gl, D), FBF ((-1), Psibar, V, Psi), Gs);
((Ubar, Gl, U), FBF ((-1), Psibar, V, Psi), Gs);
((Cbar, Gl, C), FBF ((-1), Psibar, V, Psi), Gs);
((Sbar, Gl, S), FBF ((-1), Psibar, V, Psi), Gs);
((Tbar, Gl, T), FBF ((-1), Psibar, V, Psi), Gs);
((Bbar, Gl, B), FBF ((-1), Psibar, V, Psi), Gs)]
let three_gluon =
[ ((Gl, Gl, Gl), Gauge_Gauge_Gauge 1, I_Gs)]
let gauge4 = Vector4 [(2, C_13_42); (-1, C_12_34); (-1, C_14_23)]
let four_gluon =
[ ((Gl, Gl, Gl, Gl), gauge4, G2)]
let vertices3 =
(color_current @ three_gluon)
let vertices4 = four_gluon
let vertices () =
(vertices3, vertices4, [])
let table = F.of_vertices (vertices ())
let fuse2 = F.fuse2 table
let fuse3 = F.fuse3 table
let fuse = F.fuse table
let max_degree () = 4
let parameters () = { input = [Gs, 1.0]; derived = []; derived_arrays = [] }
let flavor_of_string = function
| "u" -> U
| "d" -> D
| "c" -> C
| "s" -> S
| "t" -> T
| "b" -> B
| "ubar" -> Ubar
| "dbar" -> Dbar
| "cbar" -> Cbar
| "sbar" -> Sbar
| "tbar" -> Tbar
| "bbar" -> Bbar
| "gl" -> Gl
| _ -> invalid_arg "Modellib.QCD.flavor_of_string"
let flavor_to_string = function
| U -> "u"
| Ubar -> "ubar"
| D -> "d"
| Dbar -> "dbar"
| C -> "c"
| Cbar -> "cbar"
| S -> "s"
| Sbar -> "sbar"
| T -> "t"
| Tbar -> "tbar"
| B -> "b"
| Bbar -> "bbar"
| Gl -> "gl"
let flavor_to_TeX = function
| U -> "u"
| Ubar -> "\bar{u}"
| D -> "d"
| Dbar -> "\bar{d}"
| C -> "c"
| Cbar -> "bar{c}"
| S -> "s"
| Sbar -> "\bar{s}"
| T -> "t"
| Tbar -> "\bar{t}"
| B -> "b"
| Bbar -> "\bar{b}"
| Gl -> "g"
let flavor_symbol = function
| U -> "u"
| Ubar -> "ubar"
| D -> "d"
| Dbar -> "dbar"
| C -> "c"
| Cbar -> "cbar"
| S -> "s"
| Sbar -> "sbar"
| T -> "t"
| Tbar -> "tbar"
| B -> "b"
| Bbar -> "bbar"
| Gl -> "gl"
let gauge_symbol () =
failwith "Modellib.QCD.gauge_symbol: internal error"
let pdg = function
| D -> 1 | Dbar -> -1
| U -> 2 | Ubar -> -2
| S -> 3 | Sbar -> -3
| C -> 4 | Cbar -> -4
| B -> 5 | Bbar -> -5
| T -> 6 | Tbar -> -6
| Gl -> 21
let mass_symbol f =
"mass(" ^ string_of_int (abs (pdg f)) ^ ")"
let width_symbol f =
"width(" ^ string_of_int (abs (pdg f)) ^ ")"
let constant_symbol = function
| I_Gs -> "(0,1)*gs"
| Gs -> "gs"
| G2 -> "gs**2"
end
(* \thocwmodulesection{Complete Minimal Standard Model (Unitarity Gauge)} *)
module type SM_flags =
sig
val higgs_triangle : bool (* $H\gamma\gamma$, $Hg\gamma$ and $Hgg$ couplings *)
val triple_anom : bool
val quartic_anom : bool
val higgs_anom : bool
val k_matrix : bool
val ckm_present : bool
end
module SM_no_anomalous : SM_flags =
struct
let higgs_triangle = false
let triple_anom = false
let quartic_anom = false
let higgs_anom = false
let k_matrix = false
let ckm_present = false
end
module SM_no_anomalous_ckm : SM_flags =
struct
let higgs_triangle = false
let triple_anom = false
let quartic_anom = false
let higgs_anom = false
let k_matrix = false
let ckm_present = true
end
module SM_anomalous : SM_flags =
struct
let higgs_triangle = false
let triple_anom = true
let quartic_anom = true
let higgs_anom = true
let k_matrix = false
let ckm_present = false
end
module SM_anomalous_ckm : SM_flags =
struct
let higgs_triangle = false
let triple_anom = true
let quartic_anom = true
let higgs_anom = true
let k_matrix = false
let ckm_present = true
end
module SM_k_matrix : SM_flags =
struct
let higgs_triangle = false
let triple_anom = false
let quartic_anom = true
let higgs_anom = false
let k_matrix = true
let ckm_present = false
end
module SM_Hgg : SM_flags =
struct
let higgs_triangle = true
let triple_anom = false
let quartic_anom = false
let higgs_anom = false
let k_matrix = false
let ckm_present = false
end
module SM3 (Flags : SM_flags) =
struct
let rcs = RCS.rename rcs_file "Modellib.SM3"
[ "minimal electroweak standard model in unitarity gauge";
"with emulation of 4-point vertices; no CKM matrix" ]
open Coupling
let default_width = ref Timelike
let use_fudged_width = ref false
let options = Options.create
[ "constant_width", Arg.Unit (fun () -> default_width := Constant),
"use constant width (also in t-channel)";
"fudged_width", Arg.Set use_fudged_width,
"use fudge factor for charge particle width";
"custom_width", Arg.String (fun f -> default_width := Custom f),
"use custom width";
"cancel_widths", Arg.Unit (fun () -> default_width := Vanishing),
"use vanishing width"]
type matter_field = L of int | N of int | U of int | D of int
type gauge_boson = Ga | Wp | Wm | Z | Gl
type other =
| XWp | XWm | XW3 | XGl
| Phip | Phim | Phi0 | H | XH
| XH_W | XH_W' | XH_Z | XH_Z'
| XSWm | XSWp | XSWpp | XSWmm
| XSWZ0 | XSZW0 | XSW3 | XSZZ
| XDH_W | XDH_W' | XDH_Z | XDH_Z'
| XDH_Wm | XDH_Wp | XDH_Z''
| XDH2
type flavor = M of matter_field | G of gauge_boson | O of other
let matter_field f = M f
let gauge_boson f = G f
let other f = O f
type field =
| Matter of matter_field
| Gauge of gauge_boson
| Other of other
let field = function
| M f -> Matter f
| G f -> Gauge f
| O f -> Other f
type gauge = unit
let gauge_symbol () =
failwith "Modellib.SM3.gauge_symbol: internal error"
(* The auxiliary fields [XH_W] and [XH_W'] are
mutual charge conjugates. This way the vertex $W^+_\mu W^{-,\mu}HH$
can be split into $W^+_\mu W^{-,\mu}X_{HW}$ and $X_{HW}^*HH$ without
introducing the additional $W^+_\mu W^{-,\mu}W^+_\nu W^{-,\nu}$ and $HHHH$
couplings that a neutral auxiliary field would produce. *)
let family n = List.map matter_field [ L n; N n; U n; D n ]
let external_flavors () =
[ "1st Generation", ThoList.flatmap family [1; -1];
"2nd Generation", ThoList.flatmap family [2; -2];
"3rd Generation", ThoList.flatmap family [3; -3];
"Gauge Bosons", List.map gauge_boson [Ga; Z; Wp; Wm; Gl];
"Higgs", List.map other [H];
"Goldstone Bosons", List.map other [Phip; Phim; Phi0] ]
let flavors () =
ThoList.flatmap snd (external_flavors ()) @
List.map other
[ XWp; XWm; XW3; XGl; XH; XH_W; XH_W'; XH_Z; XH_Z';
XSWm; XSWp; XSWpp; XSWmm; XSWZ0; XSZW0; XSW3; XSZZ;
XDH_W; XDH_W'; XDH_Z; XDH_Z';
XDH_Wm; XDH_Wp; XDH_Z''; XDH2 ]
let spinor n =
if n >= 0 then
Spinor
else
ConjSpinor
let lorentz = function
| M f ->
begin match f with
| L n -> spinor n | N n -> spinor n
| U n -> spinor n | D n -> spinor n
end
| G f ->
begin match f with
| Ga | Gl -> Vector
| Wp | Wm | Z -> Massive_Vector
end
| O f ->
begin match f with
| XWp | XWm | XW3 | XGl -> Tensor_1
| Phip | Phim | Phi0 -> Scalar
| H -> Scalar | XH -> Scalar
| XH_W | XH_W' -> Scalar
| XH_Z | XH_Z' -> Scalar
| XSWm | XSWp | XSWpp | XSWmm
| XSWZ0 | XSZW0 | XSW3 | XSZZ -> Scalar
| XDH_W | XDH_W' | XDH_Z | XDH_Z'
| XDH_Wm | XDH_Wp | XDH_Z'' | XDH2 -> Scalar
end
let color = function
| M (U n) -> Color.SUN (if n > 0 then 3 else -3)
| M (D n) -> Color.SUN (if n > 0 then 3 else -3)
| G Gl -> Color.AdjSUN 3
| _ -> Color.Singlet
let prop_spinor n =
if n >= 0 then
Prop_Spinor
else
Prop_ConjSpinor
let propagator = function
| M f ->
begin match f with
| L n -> prop_spinor n | N n -> prop_spinor n
| U n -> prop_spinor n | D n -> prop_spinor n
end
| G f ->
begin match f with
| Ga | Gl -> Prop_Feynman
| Wp | Wm | Z -> Prop_Unitarity
end
| O f ->
begin match f with
| XWp | XWm | XW3 | XGl -> Aux_Tensor_1
| Phip | Phim | Phi0 -> Only_Insertion
| H -> Prop_Scalar | XH -> Aux_Scalar
| XH_W | XH_W' -> Aux_Scalar
| XH_Z | XH_Z' -> Aux_Scalar
| XSWm | XSWp | XSWpp | XSWmm
| XSWZ0 | XSZW0 | XSW3 | XSZZ -> Aux_Scalar
| XDH_W | XDH_W' | XDH_Z | XDH_Z'
| XDH_Wm | XDH_Wp | XDH_Z'' | XDH2 -> Aux_Scalar
end
(* Optionally, ask for the fudge factor treatment for the widths of
charged particles. Currently, this only applies to $W^\pm$ and top. *)
let width f =
if !use_fudged_width then
match f with
| G Wp | G Wm | M (U 3) | M (U (-3)) -> Fudged
| _ -> !default_width
else
!default_width
let goldstone = function
| G f ->
begin match f with
| Wp -> Some (O Phip, Coupling.Const 1)
| Wm -> Some (O Phim, Coupling.Const 1)
| Z -> Some (O Phi0, Coupling.Const 1)
| _ -> None
end
| _ -> None
let conjugate = function
| M f ->
M (begin match f with
| L n -> L (-n) | N n -> N (-n)
| U n -> U (-n) | D n -> D (-n)
end)
| G f ->
G (begin match f with
| Gl -> Gl | Ga -> Ga | Z -> Z
| Wp -> Wm | Wm -> Wp
end)
| O f ->
O (begin match f with
| XWp -> XWm | XWm -> XWp
| XW3 -> XW3 | XGl -> XGl
| Phip -> Phim | Phim -> Phip | Phi0 -> Phi0
| H -> H | XH -> XH
| XH_W -> XH_W' | XH_W' -> XH_W
| XH_Z -> XH_Z' | XH_Z' -> XH_Z
| XSWm -> XSWp | XSWp -> XSWm
| XSWpp -> XSWmm | XSWmm -> XSWpp
| XSWZ0 -> XSZW0 | XSZW0 -> XSWZ0
| XSW3 -> XSW3 | XSZZ -> XSZZ
| XDH_W -> XDH_W' | XDH_W' -> XDH_W
| XDH_Z -> XDH_Z' | XDH_Z' -> XDH_Z
| XDH_Wm -> XDH_Wp | XDH_Wp -> XDH_Wm
| XDH_Z'' -> XDH_Z'' | XDH2 -> XDH2
end)
let fermion = function
| M f ->
begin match f with
| L n -> if n > 0 then 1 else -1
| N n -> if n > 0 then 1 else -1
| U n -> if n > 0 then 1 else -1
| D n -> if n > 0 then 1 else -1
end
| G f ->
begin match f with
| Gl | Ga | Z | Wp | Wm -> 0
end
| O f ->
begin match f with
| XWp | XWm | XW3 | XGl -> 0
| Phip | Phim | Phi0 -> 0
| H | XH -> 0
| XH_W | XH_W' | XH_Z | XH_Z' -> 0
| XSWm | XSWp | XSWpp | XSWmm
| XSWZ0 | XSZW0 | XSW3 | XSZZ -> 0
| XDH_W | XDH_W' | XDH_Z | XDH_Z'
| XDH_Wm | XDH_Wp | XDH_Z'' | XDH2 -> 0
end
module Ch = Charges.QQ
- let charges = function
+
+ let ( // ) = Algebra.Small_Rational.make
+
+ let generation' = function
+ | 1 -> [ 1//1; 0//1; 0//1]
+ | 2 -> [ 0//1; 1//1; 0//1]
+ | 3 -> [ 0//1; 0//1; 1//1]
+ | -1 -> [-1//1; 0//1; 0//1]
+ | -2 -> [ 0//1; -1//1; 0//1]
+ | -3 -> [ 0//1; 0//1; -1//1]
+ | n -> invalid_arg ("SM3.generation': " ^ string_of_int n)
+
+ let generation f =
+ if Flags.ckm_present then
+ []
+ else
+ match f with
+ | M (L n | N n | U n | D n) -> generation' n
+ | G _ | O _ -> [0//1; 0//1; 0//1]
+
+ let charge = function
| M f ->
begin match f with
- | L n -> if n > 0 then [] else []
- | N n -> if n > 0 then [] else []
- | U n -> if n > 0 then [] else []
- | D n -> if n > 0 then [] else []
+ | L n -> if n > 0 then -1//1 else 1//1
+ | N n -> 0//1
+ | U n -> if n > 0 then 2//3 else -2//3
+ | D n -> if n > 0 then -1//3 else 1//3
end
| G f ->
begin match f with
- | Gl | Ga | Z | Wp | Wm -> []
+ | Gl | Ga | Z -> 0//1
+ | Wp -> 1//1
+ | Wm -> -1//1
end
| O f ->
begin match f with
- | XWp | XWm | XW3 | XGl -> []
- | Phip | Phim | Phi0 -> []
- | H | XH -> []
- | XH_W | XH_W' | XH_Z | XH_Z' -> []
- | XSWm | XSWp | XSWpp | XSWmm
- | XSWZ0 | XSZW0 | XSW3 | XSZZ -> []
- | XDH_W | XDH_W' | XDH_Z | XDH_Z'
- | XDH_Wm | XDH_Wp | XDH_Z'' | XDH2 -> []
+ | H | Phi0 -> 0//1
+ | Phip -> 1//1
+ | Phim -> -1//1
+ | _ -> 0//1
+ end
+
+ let lepton = function
+ | M f ->
+ begin match f with
+ | L n | N n -> if n > 0 then 1//1 else -1//1
+ | U _ | D _ -> 0//1
+ end
+ | G _ | O _ -> 0//1
+
+ let baryon = function
+ | M f ->
+ begin match f with
+ | L _ | N _ -> 0//1
+ | U n | D n -> if n > 0 then 1//1 else -1//1
end
+ | G _ | O _ -> 0//1
+
+ let charges f =
+ [ charge f; lepton f; baryon f] @ generation f
type constant =
| Unit | Pi | Alpha_QED | Sin2thw
| Sinthw | Costhw | E | G_weak | Vev
| Q_lepton | Q_up | Q_down | G_CC
| G_NC_neutrino | G_NC_lepton | G_NC_up | G_NC_down
| I_Q_W | I_G_ZWW | I_G_WWW
| I_G1_AWW | I_G1_ZWW
| I_G1_plus_kappa_plus_G4_AWW
| I_G1_plus_kappa_plus_G4_ZWW
| I_G1_plus_kappa_minus_G4_AWW
| I_G1_plus_kappa_minus_G4_ZWW
| I_G1_minus_kappa_plus_G4_AWW
| I_G1_minus_kappa_plus_G4_ZWW
| I_G1_minus_kappa_minus_G4_AWW
| I_G1_minus_kappa_minus_G4_ZWW
| I_lambda_AWW | I_lambda_ZWW
| G5_AWW | G5_ZWW
| I_kappa5_AWW | I_kappa5_ZWW
| I_lambda5_AWW | I_lambda5_ZWW
| I_Alpha_WWWW0 | I_Alpha_ZZWW1 | I_Alpha_WWWW2
| I_Alpha_ZZWW0 | I_Alpha_ZZZZ
| G_HWW | G_HHWW | G_HZZ | G_HHZZ | G_Hmm
| G_Htt | G_Hbb | G_Hcc | G_Htautau | G_H3 | G_H4
| G_HGaZ | G_HGaGa | G_Hgg
| G_strong
| Mass of flavor | Width of flavor
| I_G_DH4 | G_DH2W2 | G_DH2Z2 | G_DHW2 | G_DHZ2
(* \begin{dubious}
The current abstract syntax for parameter dependencies is admittedly
tedious. Later, there will be a parser for a convenient concrete syntax
as a part of a concrete syntax for models. But as these examples show,
it should include simple functions.
\end{dubious} *)
(* \begin{subequations}
\begin{align}
\alpha_{\text{QED}} &= \frac{1}{137.0359895} \\
\sin^2\theta_w &= 0.23124
\end{align}
\end{subequations} *)
let input_parameters =
[ Alpha_QED, 1. /. 137.0359895;
Sin2thw, 0.23124;
Mass (G Z), 91.187;
Mass (M (N 1)), 0.0; Mass (M (L 1)), 0.51099907e-3;
Mass (M (N 2)), 0.0; Mass (M (L 2)), 0.105658389;
Mass (M (N 3)), 0.0; Mass (M (L 3)), 1.77705;
Mass (M (U 1)), 5.0e-3; Mass (M (D 1)), 3.0e-3;
Mass (M (U 2)), 1.2; Mass (M (D 2)), 0.1;
Mass (M (U 3)), 174.0; Mass (M (D 3)), 4.2 ]
(* \begin{subequations}
\begin{align}
e &= \sqrt{4\pi\alpha} \\
\sin\theta_w &= \sqrt{\sin^2\theta_w} \\
\cos\theta_w &= \sqrt{1-\sin^2\theta_w} \\
g &= \frac{e}{\sin\theta_w} \\
m_W &= \cos\theta_w m_Z \\
v &= \frac{2m_W}{g} \\
g_{CC} =
-\frac{g}{2\sqrt2} &= -\frac{e}{2\sqrt2\sin\theta_w} \\
Q_{\text{lepton}} =
-q_{\text{lepton}}e &= e \\
Q_{\text{up}} =
-q_{\text{up}}e &= -\frac{2}{3}e \\
Q_{\text{down}} =
-q_{\text{down}}e &= \frac{1}{3}e \\
\ii q_We =
\ii g_{\gamma WW} &= \ii e \\
\ii g_{ZWW} &= \ii g \cos\theta_w \\
\ii g_{WWW} &= \ii g
\end{align}
\end{subequations} *)
(* \begin{dubious}
\ldots{} JR leaves this dubious as it is \ldots{}
but JR has corrected the errors....
\end{dubious}
\begin{subequations}
\begin{align}
g_{HWW} &= g m_W = 2 \frac{m_W^2}{v} \\
g_{HHWW} &= \frac{g}{\sqrt{2}} = \frac{\sqrt{2} m_W}{v} \\
g_{HZZ} &= \frac{g}{\cos\theta_w}m_Z \\
g_{HHZZ} &= \frac{g}{\sqrt{2}\cos\theta_w} = \frac{\sqrt{2} m_Z}{v} \\
g_{Htt} &= \lambda_t \\
g_{Hbb} &= \lambda_b=\frac{m_b}{m_t}\lambda_t \\
g_{H^3} &= - \frac{3g}{2} \frac{m_H^2}{m_W} = - 3 \frac{m_H^2}{v} \\
g_{H^4} &= \ii \frac{g}{2} \frac{m_H}{m_W} = \ii \frac{m_H}{v}
\end{align}
\end{subequations} *)
let derived_parameters =
[ Real E, Sqrt (Prod [Const 4; Atom Pi; Atom Alpha_QED]);
Real Sinthw, Sqrt (Atom Sin2thw);
Real Costhw, Sqrt (Diff (Const 1, Atom Sin2thw));
Real G_weak, Quot (Atom E, Atom Sinthw);
Real (Mass (G Wp)), Prod [Atom Costhw; Atom (Mass (G Z))];
Real Vev, Quot (Prod [Const 2; Atom (Mass (G Wp))], Atom G_weak);
Real Q_lepton, Atom E;
Real Q_up, Prod [Quot (Const (-2), Const 3); Atom E];
Real Q_down, Prod [Quot (Const 1, Const 3); Atom E];
Real G_CC, Neg (Quot (Atom G_weak, Prod [Const 2; Sqrt (Const 2)]));
Complex I_Q_W, Prod [I; Atom E];
Complex I_G_ZWW, Prod [I; Atom G_weak; Atom Costhw];
Complex I_G_WWW, Prod [I; Atom G_weak] ]
(* \begin{equation}
- \frac{g}{2\cos\theta_w}
\end{equation} *)
let g_over_2_costh =
Quot (Neg (Atom G_weak), Prod [Const 2; Atom Costhw])
(* \begin{subequations}
\begin{align}
- \frac{g}{2\cos\theta_w} g_V
&= - \frac{g}{2\cos\theta_w} (T_3 - 2 q \sin^2\theta_w) \\
- \frac{g}{2\cos\theta_w} g_A
&= - \frac{g}{2\cos\theta_w} T_3
\end{align}
\end{subequations} *)
let nc_coupling c t3 q =
(Real_Array c,
[Prod [g_over_2_costh; Diff (t3, Prod [Const 2; q; Atom Sin2thw])];
Prod [g_over_2_costh; t3]])
let half = Quot (Const 1, Const 2)
let derived_parameter_arrays =
[ nc_coupling G_NC_neutrino half (Const 0);
nc_coupling G_NC_lepton (Neg half) (Const (-1));
nc_coupling G_NC_up half (Quot (Const 2, Const 3));
nc_coupling G_NC_down (Neg half) (Quot (Const (-1), Const 3)) ]
let parameters () =
{ input = input_parameters;
derived = derived_parameters;
derived_arrays = derived_parameter_arrays }
module F = Modeltools.Fusions (struct
type f = flavor
type c = constant
let compare = compare
let conjugate = conjugate
end)
(* \begin{equation}
\mathcal{L}_{\textrm{EM}} =
- e \sum_i q_i \bar\psi_i\fmslash{A}\psi_i
\end{equation} *)
let mgm ((m1, g, m2), fbf, c) = ((M m1, G g, M m2), fbf, c)
let electromagnetic_currents n =
List.map mgm
[ ((L (-n), Ga, L n), FBF (1, Psibar, V, Psi), Q_lepton);
((U (-n), Ga, U n), FBF (1, Psibar, V, Psi), Q_up);
((D (-n), Ga, D n), FBF (1, Psibar, V, Psi), Q_down) ]
(* \begin{equation}
\mathcal{L}_{\textrm{NC}} =
- \frac{g}{2\cos\theta_W}
\sum_i \bar\psi_i\fmslash{Z}(g_V^i-g_A^i\gamma_5)\psi_i
\end{equation} *)
let neutral_currents n =
List.map mgm
[ ((L (-n), Z, L n), FBF (1, Psibar, VA, Psi), G_NC_lepton);
((N (-n), Z, N n), FBF (1, Psibar, VA, Psi), G_NC_neutrino);
((U (-n), Z, U n), FBF (1, Psibar, VA, Psi), G_NC_up);
((D (-n), Z, D n), FBF (1, Psibar, VA, Psi), G_NC_down) ]
(* \begin{equation}
\mathcal{L}_{\textrm{CC}} =
- \frac{g}{2\sqrt2} \sum_i \bar\psi_i
(T^+\fmslash{W}^+ + T^-\fmslash{W}^-)(1-\gamma_5)\psi_i
\end{equation} *)
let charged_currents n =
List.map mgm
[ ((L (-n), Wm, N n), FBF (1, Psibar, VL, Psi), G_CC);
((N (-n), Wp, L n), FBF (1, Psibar, VL, Psi), G_CC);
((D (-n), Wm, U n), FBF (1, Psibar, VL, Psi), G_CC);
((U (-n), Wp, D n), FBF (1, Psibar, VL, Psi), G_CC) ]
let yukawa =
[ ((M (U (-3)), O H, M (U 3)), FBF (1, Psibar, S, Psi), G_Htt);
((M (D (-3)), O H, M (D 3)), FBF (1, Psibar, S, Psi), G_Hbb);
((M (U (-2)), O H, M (U 2)), FBF (1, Psibar, S, Psi), G_Hcc);
((M (L (-2)), O H, M (L 2)), FBF (1, Psibar, S, Psi), G_Hmm);
((M (L (-3)), O H, M (L 3)), FBF (1, Psibar, S, Psi), G_Htautau) ]
(* \begin{equation}
\mathcal{L}_{\textrm{TGC}} =
- e \partial_\mu A_\nu W_+^\mu W_-^\nu + \ldots
- e \cot\theta_w \partial_\mu Z_\nu W_+^\mu W_-^\nu + \ldots
\end{equation} *)
let tgc ((g1, g2, g3), t, c) = ((G g1, G g2, G g3), t, c)
let standard_triple_gauge =
List.map tgc
[ ((Ga, Wm, Wp), Gauge_Gauge_Gauge 1, I_Q_W);
((Z, Wm, Wp), Gauge_Gauge_Gauge 1, I_G_ZWW) ]
(* \begin{multline}
\mathcal{L}_{\textrm{TGC}}(g_1,\kappa)
= g_1 \mathcal{L}_T(V,W^+,W^-) \\
+ \frac{\kappa+g_1}{2} \Bigl(\mathcal{L}_T(W^-,V,W^+)
- \mathcal{L}_T(W^+,V,W^-)\Bigr)\\
+ \frac{\kappa-g_1}{2} \Bigl(\mathcal{L}_L(W^-,V,W^+)
- \mathcal{L}_T(W^+,V,W^-)\Bigr)
\end{multline} *)
(* \begin{dubious}
The whole thing in the LEP2 workshop notation:
\begin{multline}
\ii\mathcal{L}_{\textrm{TGC},V} / g_{WWV} = \\
g_1^V V^\mu (W^-_{\mu\nu}W^{+,\nu}-W^+_{\mu\nu}W^{-,\nu})
+ \kappa_V W^+_\mu W^-_\nu V^{\mu\nu}
+ \frac{\lambda_V}{m_W^2} V_{\mu\nu}
W^-_{\rho\mu} W^{+,\hphantom{\nu}\rho}_{\hphantom{+,}\nu} \\
+ \ii g_5^V \epsilon_{\mu\nu\rho\sigma}
\left( (\partial^\rho W^{-,\mu}) W^{+,\nu}
- W^{-,\mu}(\partial^\rho W^{+,\nu}) \right) V^\sigma \\
+ \ii g_4^V W^-_\mu W^+_\nu (\partial^\mu V^\nu + \partial^\nu V^\mu)
- \frac{\tilde\kappa_V}{2} W^-_\mu W^+_\nu \epsilon^{\mu\nu\rho\sigma}
V_{\rho\sigma}
- \frac{\tilde\lambda_V}{2m_W^2}
W^-_{\rho\mu} W^{+,\mu}_{\hphantom{+,\mu}\nu} \epsilon^{\nu\rho\alpha\beta}
V_{\alpha\beta}
\end{multline}
using the conventions of Itzykson and Zuber with $\epsilon^{0123} = +1$.
\end{dubious} *)
(* \begin{dubious}
This is equivalent to the notation of Hagiwara et al.~\cite{HPZH87}, if we
remember that they have opposite signs for~$g_{WWV}$:
\begin{multline}
\mathcal{L}_{WWV} / (-g_{WWV}) = \\
\ii g_1^V \left( W^\dagger_{\mu\nu} W^\mu
- W^\dagger_\mu W^\mu_{\hphantom{\mu}\nu} \right) V^\nu
+ \ii \kappa_V W^\dagger_\mu W_\nu V^{\mu\nu}
+ \ii \frac{\lambda_V}{m_W^2}
W^\dagger_{\lambda\mu} W^\mu_{\hphantom{\mu}\nu} V^{\nu\lambda} \\
- g_4^V W^\dagger_\mu W_\nu
\left(\partial^\mu V^\nu + \partial^\nu V^\mu \right)
+ g_5^V \epsilon^{\mu\nu\lambda\sigma}
\left( W^\dagger_\mu \stackrel{\leftrightarrow}{\partial_\lambda}
W_\nu \right) V_\sigma\\
+ \ii \tilde\kappa_V W^\dagger_\mu W_\nu \tilde{V}^{\mu\nu}
+ \ii\frac{\tilde\lambda_V}{m_W^2}
W^\dagger_{\lambda\mu} W^\mu_{\hphantom{\mu}\nu} \tilde{V}^{\nu\lambda}
\end{multline}
Here $V^\mu$ stands for either the photon or the~$Z$ field, $W^\mu$ is the
$W^-$ field, $W_{\mu\nu} = \partial_\mu W_\nu - \partial_\nu W_\mu$,
$V_{\mu\nu} = \partial_\mu V_\nu - \partial_\nu V_\mu$, and
$\tilde{V}_{\mu\nu} = \frac{1}{2} \epsilon_{\mu\nu\lambda\sigma}
V^{\lambda\sigma}$.
\end{dubious} *)
let anomalous_triple_gauge =
List.map tgc
[ ((Ga, Wm, Wp), Dim4_Vector_Vector_Vector_T (-1),
I_G1_AWW);
((Z, Wm, Wp), Dim4_Vector_Vector_Vector_T (-1),
I_G1_ZWW);
((Wm, Ga, Wp), Dim4_Vector_Vector_Vector_T 1,
I_G1_plus_kappa_minus_G4_AWW);
((Wm, Z, Wp), Dim4_Vector_Vector_Vector_T 1,
I_G1_plus_kappa_minus_G4_ZWW);
((Wp, Ga, Wm), Dim4_Vector_Vector_Vector_T (-1),
I_G1_plus_kappa_plus_G4_AWW);
((Wp, Z, Wm), Dim4_Vector_Vector_Vector_T (-1),
I_G1_plus_kappa_plus_G4_ZWW);
((Wm, Ga, Wp), Dim4_Vector_Vector_Vector_L (-1),
I_G1_minus_kappa_plus_G4_AWW);
((Wm, Z, Wp), Dim4_Vector_Vector_Vector_L (-1),
I_G1_minus_kappa_plus_G4_ZWW);
((Wp, Ga, Wm), Dim4_Vector_Vector_Vector_L 1,
I_G1_minus_kappa_minus_G4_AWW);
((Wp, Z, Wm), Dim4_Vector_Vector_Vector_L 1,
I_G1_minus_kappa_minus_G4_ZWW);
((Ga, Wm, Wp), Dim4_Vector_Vector_Vector_T5 (-1),
I_kappa5_AWW);
((Z, Wm, Wp), Dim4_Vector_Vector_Vector_T5 (-1),
I_kappa5_ZWW);
((Ga, Wm, Wp), Dim4_Vector_Vector_Vector_L5 (-1),
G5_AWW);
((Z, Wm, Wp), Dim4_Vector_Vector_Vector_L5 (-1),
G5_ZWW);
((Ga, Wp, Wm), Dim6_Gauge_Gauge_Gauge (-1),
I_lambda_AWW);
((Z, Wp, Wm), Dim6_Gauge_Gauge_Gauge (-1),
I_lambda_ZWW);
((Ga, Wp, Wm), Dim6_Gauge_Gauge_Gauge_5 (-1),
I_lambda5_AWW);
((Z, Wp, Wm), Dim6_Gauge_Gauge_Gauge_5 (-1),
I_lambda5_ZWW) ]
let triple_gauge =
if Flags.triple_anom then
anomalous_triple_gauge
else
standard_triple_gauge
(* \begin{equation}
\mathcal{L}_{\textrm{QGC}} =
- g^2 W_{+,\mu} W_{-,\nu} W_+^\mu W_-^\nu + \ldots
\end{equation} *)
let tgc_aux ((aux, g1, g2), t, c) = ((O aux, G g1, G g2), t, c)
let standard_quartic_gauge =
List.map tgc_aux
[ ((XW3, Wm, Wp), Aux_Gauge_Gauge 1, I_G_WWW);
((XWm, Wp, Ga), Aux_Gauge_Gauge 1, I_Q_W);
((XWm, Wp, Z), Aux_Gauge_Gauge 1, I_G_ZWW);
((XWp, Ga, Wm), Aux_Gauge_Gauge 1, I_Q_W);
((XWp, Z, Wm), Aux_Gauge_Gauge 1, I_G_ZWW) ]
(* \begin{subequations}
\begin{align}
\mathcal{L}_4
&= \alpha_4 \left( \frac{g^4}{2}\left( (W^+_\mu W^{-,\mu})^2
+ W^+_\mu W^{+,\mu} W^-_\mu W^{-,\mu}
\right)\right.\notag \\
&\qquad\qquad\qquad \left.
+ \frac{g^4}{\cos^2\theta_w} W^+_\mu Z^\mu W^-_\nu Z^\nu
+ \frac{g^4}{4\cos^4\theta_w} (Z_\mu Z^\mu)^2 \right) \\
\mathcal{L}_5
&= \alpha_5 \left( g^4 (W^+_\mu W^{-,\mu})^2
+ \frac{g^4}{\cos^2\theta_w} W^+_\mu W^{-,\mu} Z_\nu Z^\nu
+ \frac{g^4}{4\cos^4\theta_w} (Z_\mu Z^\mu)^2 \right)
\end{align}
\end{subequations}
or
\begin{multline}
\mathcal{L}_4 + \mathcal{L}_5
= (\alpha_4+2\alpha_5) g^4 \frac{1}{2} (W^+_\mu W^{-,\mu})^2 \\
+ 2\alpha_4 g^4 \frac{1}{4} W^+_\mu W^{+,\mu} W^-_\mu W^{-,\mu}
+ \alpha_4 \frac{g^4}{\cos^2\theta_w} W^+_\mu Z^\mu W^-_\nu Z^\nu \\
+ 2\alpha_5 \frac{g^4}{\cos^2\theta_w} \frac{1}{2} W^+_\mu W^{-,\mu} Z_\nu Z^\nu
+ (2\alpha_4 + 2\alpha_5) \frac{g^4}{\cos^4\theta_w} \frac{1}{8} (Z_\mu Z^\mu)^2
\end{multline}
and therefore
\begin{subequations}
\begin{align}
(\ii\alpha_{(WW)_0})^2 &= (\alpha_4+2\alpha_5) g^4 \\
(\ii\alpha_{(WW)_2})^2 &= 2\alpha_4 g^4 \\
(\ii\alpha_{(WZ)_\pm})^2 &= \alpha_4 \frac{g^4}{\cos^2\theta_w} \\
(\ii\alpha_{(WZ)_0})^2 &= 2\alpha_5 \frac{g^4}{\cos^2\theta_w} \\
(\ii\alpha_{ZZ})^2 &= (2\alpha_4 + 2\alpha_5) \frac{g^4}{\cos^4\theta_w}
\end{align}
\end{subequations}
Not that the auxiliary couplings are purely imaginary, because~$\alpha_4$
and~$\alpha_5$ are defined with a \emph{positive} sign and we expect
quartic couplings to have a \emph{negative} sign for the energy to be
bounded from below. *)
let anomalous_quartic_gauge =
List.map tgc_aux
[ ((XSW3, Wm, Wp), Aux_Vector_Vector 1, I_Alpha_WWWW0);
((XSWpp, Wm, Wm), Aux_Vector_Vector 1, I_Alpha_WWWW2);
((XSWmm, Wp, Wp), Aux_Vector_Vector 1, I_Alpha_WWWW2);
((XSWm, Wp, Z), Aux_Vector_Vector 1, I_Alpha_ZZWW1);
((XSWp, Wm, Z), Aux_Vector_Vector 1, I_Alpha_ZZWW1);
((XSWZ0, Wp, Wm), Aux_Vector_Vector 1, I_Alpha_ZZWW0);
((XSZW0, Z, Z), Aux_Vector_Vector 1, I_Alpha_ZZWW0);
((XSZZ, Z, Z), Aux_Vector_Vector 1, I_Alpha_ZZZZ) ]
let quartic_gauge =
if Flags.quartic_anom then
standard_quartic_gauge @ anomalous_quartic_gauge
else
standard_quartic_gauge
let standard_gauge_higgs =
[ ((O H, G Wp, G Wm), Scalar_Vector_Vector 1, G_HWW);
((O H, G Z, G Z), Scalar_Vector_Vector 1, G_HZZ);
((O XH_W, G Wp, G Wm), Aux_Vector_Vector 1, G_HHWW);
((O XH_W', O H, O H), Aux_Scalar_Scalar 1, G_HHWW);
((O XH_Z, G Z, G Z), Aux_Vector_Vector 1, G_HHZZ);
((O XH_Z', O H, O H), Aux_Scalar_Scalar 1, G_HHZZ) ]
(* WK's couplings (apparently, he still intends to divide by
$\Lambda^2_{\text{EWSB}}=16\pi^2v_{\mathrm{F}}^2$):
\begin{subequations}
\begin{align}
\mathcal{L}^{\tau}_4 &=
\left\lbrack (\partial_{\mu}H)(\partial^{\mu}H)
+ \frac{g^2v_{\mathrm{F}}^2}{4} V_{\mu} V^{\mu} \right\rbrack^2 \\
\mathcal{L}^{\tau}_5 &=
\left\lbrack (\partial_{\mu}H)(\partial_{\nu}H)
+ \frac{g^2v_{\mathrm{F}}^2}{4} V_{\mu} V_{\nu} \right\rbrack^2
\end{align}
\end{subequations}
with
\begin{equation}
V_{\mu} V_{\nu} =
\frac{1}{2} \left( W^+_{\mu} W^-_{\nu} + W^+_{\nu} W^-_{\mu} \right)
+ \frac{1}{2\cos^2\theta_{w}} Z_{\mu} Z_{\nu}
\end{equation}
(note the symmetrization!), i.\,e.
\begin{subequations}
\begin{align}
\mathcal{L}_4 &= \alpha_4 \frac{g^4v_{\mathrm{F}}^4}{16} (V_{\mu} V_{\nu})^2 \\
\mathcal{L}_5 &= \alpha_5 \frac{g^4v_{\mathrm{F}}^4}{16} (V_{\mu} V^{\mu})^2
\end{align}
\end{subequations} *)
(* Breaking thinks up
\begin{subequations}
\begin{align}
\mathcal{L}^{\tau,H^4}_4 &=
\left\lbrack (\partial_{\mu}H)(\partial^{\mu}H) \right\rbrack^2 \\
\mathcal{L}^{\tau,H^4}_5 &=
\left\lbrack (\partial_{\mu}H)(\partial^{\mu}H) \right\rbrack^2
\end{align}
\end{subequations}
and
\begin{subequations}
\begin{align}
\mathcal{L}^{\tau,H^2V^2}_4 &= \frac{g^2v_{\mathrm{F}}^2}{2}
(\partial_{\mu}H)(\partial^{\mu}H) V_{\mu}V^{\mu} \\
\mathcal{L}^{\tau,H^2V^2}_5 &= \frac{g^2v_{\mathrm{F}}^2}{2}
(\partial_{\mu}H)(\partial_{\nu}H) V_{\mu}V_{\nu}
\end{align}
\end{subequations}
i.\,e.
\begin{subequations}
\begin{align}
\mathcal{L}^{\tau,H^2V^2}_4 &=
\frac{g^2v_{\mathrm{F}}^2}{2}
\left\lbrack
(\partial_{\mu}H)(\partial^{\mu}H) W^+_{\nu}W^{-,\nu}
+ \frac{1}{2\cos^2\theta_{w}} (\partial_{\mu}H)(\partial^{\mu}H) Z_{\nu} Z^{\nu}
\right\rbrack \\
\mathcal{L}^{\tau,H^2V^2}_5 &=
\frac{g^2v_{\mathrm{F}}^2}{2}
\left\lbrack
(W^{+,\mu}\partial_{\mu}H) (W^{-,\nu}\partial_{\nu}H)
+ \frac{1}{2\cos^2\theta_{w}} (Z^{\mu}\partial_{\mu}H)(Z^{\nu}\partial_{\nu}H)
\right\rbrack
\end{align}
\end{subequations} *)
(* \begin{multline}
\tau^4_8 \mathcal{L}^{\tau,H^2V^2}_4 + \tau^5_8 \mathcal{L}^{\tau,H^2V^2}_5 = \\
- \frac{g^2v_{\mathrm{F}}^2}{2} \Biggl\lbrack
2\tau^4_8
\frac{1}{2}(\ii\partial_{\mu}H)(\ii\partial^{\mu}H) W^+_{\nu}W^{-,\nu}
+ \tau^5_8
(W^{+,\mu}\ii\partial_{\mu}H) (W^{-,\nu}\ii\partial_{\nu}H) \\
+ \frac{2\tau^4_8}{\cos^2\theta_{w}}
\frac{1}{4} (\ii\partial_{\mu}H)(\ii\partial^{\mu}H) Z_{\nu} Z^{\nu}
+ \frac{\tau^5_8}{\cos^2\theta_{w}}
\frac{1}{2} (Z^{\mu}\ii\partial_{\mu}H)(Z^{\nu}\ii\partial_{\nu}H)
\Biggr\rbrack
\end{multline}
where the two powers of $\ii$ make the sign conveniently negative,
i.\,e.
\begin{subequations}
\begin{align}
\alpha_{(\partial H)^2W^2}^2 &= \tau^4_8 g^2v_{\mathrm{F}}^2\\
\alpha_{(\partial HW)^2}^2 &= \frac{\tau^5_8 g^2v_{\mathrm{F}}^2}{2} \\
\alpha_{(\partial H)^2Z^2}^2 &= \frac{\tau^4_8 g^2v_{\mathrm{F}}^2}{\cos^2\theta_{w}} \\
\alpha_{(\partial HZ)^2}^2 &=\frac{\tau^5_8 g^2v_{\mathrm{F}}^2}{2\cos^2\theta_{w}}
\end{align}
\end{subequations} *)
let anomalous_gauge_higgs =
[ ((O XDH_W, O H, O H), Aux_DScalar_DScalar 1, G_DH2W2);
((O XDH_W', G Wp, G Wm), Aux_Vector_Vector 1, G_DH2W2);
((O XDH_Z, O H, O H), Aux_DScalar_DScalar 1, G_DH2Z2);
((O XDH_Z', G Z, G Z), Aux_Vector_Vector 1, G_DH2Z2);
((O XDH_Wm, G Wp, O H), Aux_Vector_DScalar 1, G_DHW2);
((O XDH_Wp, G Wm, O H), Aux_Vector_DScalar 1, G_DHW2);
((O XDH_Z'', G Z, O H), Aux_Vector_DScalar 1, G_DHZ2) ]
let gauge_higgs =
if Flags.higgs_anom then
standard_gauge_higgs @ anomalous_gauge_higgs
else
standard_gauge_higgs
(* \begin{equation}
\mathcal{L}_{\text{Higgs}} =
\frac{1}{3!} g_{H,3} H^3 - \frac{1}{4!} g_{H,4}^2 H^4
\end{equation}
According to~(\ref{eq:quartic-aux}), the required negative sign
for the quartic piece is reproduced by any real $g_{H,4}$ in the
auxiliary field couplings.
\begin{multline}
\mathcal{L}_{\text{Higgs}} =
- \frac{1}{4!} g_{H,4}^2 \left((\phi^\dagger\phi)^2 - \mu^2\right)^2 \\
\to - \frac{1}{4!} g_{H,4}^2 \left((\mu+H)^2 - \mu^2\right)^2
= - \frac{1}{4!} g_{H,4}^2 \left(2\mu H + H^2\right)^2 \\
= - \frac{1}{4!} g_{H,4}^2 H^4
- \frac{1}{3!} g_{H,4}^2 \mu H^3
- \frac{1}{3!} g_{H,4}^2 \mu^2 H^2
\end{multline} *)
let standard_higgs =
[ ((O H, O H, O H), Scalar_Scalar_Scalar 1, G_H3);
((O XH, O H, O H), Aux_Scalar_Scalar 1, G_H4) ]
(* \begin{equation}
\tau^4_8 \mathcal{L}^{\tau,H^4}_4 + \tau^5_8 \mathcal{L}^{\tau,H^4}_5
= 8 (\tau^4_8+\tau^5_8) \frac{1}{8}
\left\lbrack (\ii\partial_{\mu}H)(\ii\partial^{\mu}H) \right\rbrack^2
\end{equation}
since there are four powers of $\ii$, the sign remains positive,
i.\,e.
\begin{equation}
(\ii\alpha_{(\partial H)^4})^2 = 8 (\tau^4_8+\tau^5_8)
\end{equation} *)
let anomalous_higgs =
[ ((O XDH2, O H, O H), Aux_DScalar_DScalar 1, I_G_DH4) ]
let higgs_triangle_vertices =
if Flags.higgs_triangle then
[ (O H, G Ga, G Ga), Dim5_Scalar_Gauge2 1, G_HGaGa;
(O H, G Ga, G Z), Dim5_Scalar_Gauge2 1, G_HGaZ;
(O H, G Gl, G Gl), Dim5_Scalar_Gauge2 1, G_Hgg ]
else
[]
let higgs =
if Flags.higgs_anom then
standard_higgs @ anomalous_higgs
else
standard_higgs
let goldstone_vertices =
[ ((O Phi0, G Wm, G Wp), Scalar_Vector_Vector 1, I_G_ZWW);
((O Phip, G Ga, G Wm), Scalar_Vector_Vector 1, I_Q_W);
((O Phip, G Z, G Wm), Scalar_Vector_Vector 1, I_G_ZWW);
((O Phim, G Wp, G Ga), Scalar_Vector_Vector 1, I_Q_W);
((O Phim, G Wp, G Z), Scalar_Vector_Vector 1, I_G_ZWW) ]
let vertices3 =
(ThoList.flatmap electromagnetic_currents [1;2;3] @
ThoList.flatmap neutral_currents [1;2;3] @
ThoList.flatmap charged_currents [1;2;3] @
yukawa @ triple_gauge @ quartic_gauge @
gauge_higgs @ higgs @ higgs_triangle_vertices @ goldstone_vertices)
let vertices () = (vertices3, [], [])
(* For efficiency, make sure that [F.of_vertices vertices] is
evaluated only once. *)
let table = F.of_vertices (vertices ())
let fuse2 = F.fuse2 table
let fuse3 = F.fuse3 table
let fuse = F.fuse table
let max_degree () = 3
let flavor_of_string = function
| "e-" -> M (L 1) | "e+" -> M (L (-1))
| "mu-" -> M (L 2) | "mu+" -> M (L (-2))
| "tau-" -> M (L 3) | "tau+" -> M (L (-3))
| "nue" -> M (N 1) | "nuebar" -> M (N (-1))
| "numu" -> M (N 2) | "numubar" -> M (N (-2))
| "nutau" -> M (N 3) | "nutaubar" -> M (N (-3))
| "u" -> M (U 1) | "ubar" -> M (U (-1))
| "c" -> M (U 2) | "cbar" -> M (U (-2))
| "t" -> M (U 3) | "tbar" -> M (U (-3))
| "d" -> M (D 1) | "dbar" -> M (D (-1))
| "s" -> M (D 2) | "sbar" -> M (D (-2))
| "b" -> M (D 3) | "bbar" -> M (D (-3))
| "g" -> G Gl
| "A" -> G Ga | "Z" | "Z0" -> G Z
| "W+" -> G Wp | "W-" -> G Wm
| "H" -> O H
| _ -> invalid_arg "Modellib.SM3.flavor_of_string"
let flavor_to_string = function
| M f ->
begin match f with
| L 1 -> "e-" | L (-1) -> "e+"
| L 2 -> "mu-" | L (-2) -> "mu+"
| L 3 -> "tau-" | L (-3) -> "tau+"
| L _ -> invalid_arg
"Modellib.SM3.flavor_to_string: invalid lepton"
| N 1 -> "nue" | N (-1) -> "nuebar"
| N 2 -> "numu" | N (-2) -> "numubar"
| N 3 -> "nutau" | N (-3) -> "nutaubar"
| N _ -> invalid_arg
"Modellib.SM3.flavor_to_string: invalid neutrino"
| U 1 -> "u" | U (-1) -> "ubar"
| U 2 -> "c" | U (-2) -> "cbar"
| U 3 -> "t" | U (-3) -> "tbar"
| U _ -> invalid_arg
"Modellib.SM3.flavor_to_string: invalid up type quark"
| D 1 -> "d" | D (-1) -> "dbar"
| D 2 -> "s" | D (-2) -> "sbar"
| D 3 -> "b" | D (-3) -> "bbar"
| D _ -> invalid_arg
"Modellib.SM3.flavor_to_string: invalid down type quark"
end
| G f ->
begin match f with
| Gl -> "g"
| Ga -> "A" | Z -> "Z"
| Wp -> "W+" | Wm -> "W-"
end
| O f ->
begin match f with
| XWp -> "W+aux" | XWm -> "W-aux"
| XW3 -> "W3aux" | XGl -> "gaux"
| Phip -> "phi+" | Phim -> "phi-" | Phi0 -> "phi0"
| H -> "H" | XH -> "Haux"
| XH_W -> "HW1aux" | XH_W' -> "HW2aux"
| XH_Z -> "HZ1aux" | XH_Z' -> "HZ2aux"
| XSWm -> "W-Zaux" | XSWp -> "W+Zaux"
| XSWpp -> "W+W+aux" | XSWmm -> "W-W-aux"
| XSWZ0 -> "W+W-/ZZaux" | XSZW0 -> "ZZ/W+W-aux"
| XSW3 -> "W+W-aux" | XSZZ -> "ZZaux"
| XDH_W -> "DHDH/W+W-aux" | XDH_W' -> "DHDH/W+W-aux'"
| XDH_Z -> "DHDH/ZZaux" | XDH_Z' -> "DHDH/ZZaux'"
| XDH_Wm -> "DHW-aux" | XDH_Wp -> "DHW+aux"
| XDH_Z'' -> "DHZaux" | XDH2 -> "DHDHaux"
end
let flavor_to_TeX = function
| M f ->
begin match f with
| L 1 -> "e^-" | L (-1) -> "e^+"
| L 2 -> "\\mu^-" | L (-2) -> "\\mu^+"
| L 3 -> "\\tau^-" | L (-3) -> "\\tau^+"
| L _ -> invalid_arg
"Modellib.SM3.flavor_to_TeX: invalid lepton"
| N 1 -> "\\nu_e" | N (-1) -> "\\bar{\\nu}_e"
| N 2 -> "\\nu_\\mu" | N (-2) -> "\\bar{\\nu}_\\mu"
| N 3 -> "\\nu_\\tau" | N (-3) -> "\\bar{\\nu}_\\tau"
| N _ -> invalid_arg
"Modellib.SM3.flavor_to_TeX: invalid neutrino"
| U 1 -> "u" | U (-1) -> "\\bar{u}"
| U 2 -> "c" | U (-2) -> "\\bar{c}"
| U 3 -> "t" | U (-3) -> "\\bar{t}"
| U _ -> invalid_arg
"Modellib.SM3.flavor_to_TeX: invalid up type quark"
| D 1 -> "d" | D (-1) -> "\\bar{d}"
| D 2 -> "s" | D (-2) -> "\\bar{s}"
| D 3 -> "b" | D (-3) -> "\\bar{b}"
| D _ -> invalid_arg
"Modellib.SM3.flavor_to_TeX: invalid down type quark"
end
| G f ->
begin match f with
| Gl -> "g"
| Ga -> "\\gamma" | Z -> "Z"
| Wp -> "W^+" | Wm -> "W^-"
end
| O f ->
begin match f with
| XWp -> "W+aux" | XWm -> "W-aux"
| XW3 -> "W3aux" | XGl -> "gaux"
| Phip -> "phi+" | Phim -> "phi-" | Phi0 -> "phi0"
| H -> "H" | XH -> "Haux"
| XH_W -> "HW1aux" | XH_W' -> "HW2aux"
| XH_Z -> "HZ1aux" | XH_Z' -> "HZ2aux"
| XSWm -> "W-Zaux" | XSWp -> "W+Zaux"
| XSWpp -> "W+W+aux" | XSWmm -> "W-W-aux"
| XSWZ0 -> "W+W-/ZZaux" | XSZW0 -> "ZZ/W+W-aux"
| XSW3 -> "W+W-aux" | XSZZ -> "ZZaux"
| XDH_W -> "DHDH/W+W-aux" | XDH_W' -> "DHDH/W+W-aux'"
| XDH_Z -> "DHDH/ZZaux" | XDH_Z' -> "DHDH/ZZaux'"
| XDH_Wm -> "DHW-aux" | XDH_Wp -> "DHW+aux"
| XDH_Z'' -> "DHZaux" | XDH2 -> "DHDHaux"
end
let flavor_symbol = function
| M f ->
begin match f with
| L n when n > 0 -> "l" ^ string_of_int n
| L n -> "l" ^ string_of_int (abs n) ^ "b"
| N n when n > 0 -> "n" ^ string_of_int n
| N n -> "n" ^ string_of_int (abs n) ^ "b"
| U n when n > 0 -> "u" ^ string_of_int n
| U n -> "u" ^ string_of_int (abs n) ^ "b"
| D n when n > 0 -> "d" ^ string_of_int n
| D n -> "d" ^ string_of_int (abs n) ^ "b"
end
| G f ->
begin match f with
| Gl -> "gl"
| Ga -> "a" | Z -> "z"
| Wp -> "wp" | Wm -> "wm"
end
| O f ->
begin match f with
| XWp -> "xwp" | XWm -> "xwm"
| XW3 -> "xw3" | XGl -> "xgl"
| Phip -> "pp" | Phim -> "pm" | Phi0 -> "p0"
| H -> "h" | XH -> "xh"
| XH_W -> "xhw1" | XH_W' -> "xhw2"
| XH_Z -> "xhz1" | XH_Z' -> "xhz2"
| XSWm -> "xswm" | XSWp -> "xswp"
| XSWpp -> "xswpp" | XSWmm -> "xswmm"
| XSWZ0 -> "xswz0" | XSZW0 -> "xszw0"
| XSW3 -> "xsww" | XSZZ -> "xszz"
| XDH_W -> "xdhw1" | XDH_W' -> "xdhw2"
| XDH_Z -> "xdhz1" | XDH_Z' -> "xdhz2"
| XDH_Wm -> "xdhwm" | XDH_Wp -> "xdhwp"
| XDH_Z'' -> "xdhz" | XDH2 -> "xdh"
end
let pdg = function
| M f ->
begin match f with
| L n when n > 0 -> 9 + 2*n
| L n -> - 9 + 2*n
| N n when n > 0 -> 10 + 2*n
| N n -> - 10 + 2*n
| U n when n > 0 -> 2*n
| U n -> 2*n
| D n when n > 0 -> - 1 + 2*n
| D n -> 1 + 2*n
end
| G f ->
begin match f with
| Gl -> 21
| Ga -> 22 | Z -> 23
| Wp -> 24 | Wm -> (-24)
end
| O f ->
begin match f with
| XWp | XWm | XW3 | XGl -> 0
| Phip | Phim -> 27 | Phi0 -> 26
| H -> 25
| XH -> 0
| XH_W | XH_W' -> 0
| XH_Z | XH_Z' -> 0
| XSWm | XSWp | XSWpp | XSWmm
| XSWZ0 | XSZW0 | XSW3 | XSZZ -> 0
| XDH_W | XDH_W' | XDH_Z | XDH_Z'
| XDH_Wm | XDH_Wp | XDH_Z'' | XDH2 -> 0
end
let mass_symbol f =
"mass(" ^ string_of_int (abs (pdg f)) ^ ")"
let width_symbol f =
"width(" ^ string_of_int (abs (pdg f)) ^ ")"
let constant_symbol = function
| Unit -> "unit" | Pi -> "PI"
| Alpha_QED -> "alpha" | E -> "e" | G_weak -> "g" | Vev -> "vev"
| Sin2thw -> "sin2thw" | Sinthw -> "sinthw" | Costhw -> "costhw"
| Q_lepton -> "qlep" | Q_up -> "qup" | Q_down -> "qdwn"
| G_NC_lepton -> "gnclep" | G_NC_neutrino -> "gncneu"
| G_NC_up -> "gncup" | G_NC_down -> "gncdwn"
| G_CC -> "gcc"
| I_Q_W -> "iqw" | I_G_ZWW -> "igzww" | I_G_WWW -> "igwww"
| I_G1_AWW -> "ig1a" | I_G1_ZWW -> "ig1z"
| I_G1_plus_kappa_plus_G4_AWW -> "ig1pkpg4a"
| I_G1_plus_kappa_plus_G4_ZWW -> "ig1pkpg4z"
| I_G1_plus_kappa_minus_G4_AWW -> "ig1pkmg4a"
| I_G1_plus_kappa_minus_G4_ZWW -> "ig1pkmg4z"
| I_G1_minus_kappa_plus_G4_AWW -> "ig1mkpg4a"
| I_G1_minus_kappa_plus_G4_ZWW -> "ig1mkpg4z"
| I_G1_minus_kappa_minus_G4_AWW -> "ig1mkmg4a"
| I_G1_minus_kappa_minus_G4_ZWW -> "ig1mkmg4z"
| I_lambda_AWW -> "ila"
| I_lambda_ZWW -> "ilz"
| G5_AWW -> "rg5a"
| G5_ZWW -> "rg5z"
| I_kappa5_AWW -> "ik5a"
| I_kappa5_ZWW -> "ik5z"
| I_lambda5_AWW -> "il5a" | I_lambda5_ZWW -> "il5z"
| I_Alpha_WWWW0 -> "ialww0" | I_Alpha_WWWW2 -> "ialww2"
| I_Alpha_ZZWW0 -> "ialzw0" | I_Alpha_ZZWW1 -> "ialzw1"
| I_Alpha_ZZZZ -> "ialzz"
| G_HWW -> "ghww" | G_HZZ -> "ghzz"
| G_HHWW -> "ghhww" | G_HHZZ -> "ghhzz"
| G_Htt -> "ghtt" | G_Hbb -> "ghbb"
| G_Htautau -> "ghtautau" | G_Hcc -> "ghcc" | G_Hmm -> "ghmm"
| G_H3 -> "gh3" | G_H4 -> "gh4"
| G_HGaZ -> "ghgaz" | G_HGaGa -> "ghgaga" | G_Hgg -> "ghgg"
| G_strong -> "gs"
| Mass f -> "mass" ^ flavor_symbol f
| Width f -> "width" ^ flavor_symbol f
| I_G_DH4 -> "igdh4"
| G_DH2W2 -> "gdh2w2" | G_DH2Z2 -> "gdh2z2"
| G_DHW2 -> "gdhw2" | G_DHZ2 -> "gdhz2"
end
(* \thocwmodulesection{Complete Minimal Standard Model with Genuine Quartic Couplings} *)
module SM (Flags : SM_flags) =
struct
let rcs = RCS.rename rcs_file "Modellib.SM"
[ "minimal electroweak standard model in unitarity gauge"]
open Coupling
let default_width = ref Timelike
let use_fudged_width = ref false
let options = Options.create
[ "constant_width", Arg.Unit (fun () -> default_width := Constant),
"use constant width (also in t-channel)";
"fudged_width", Arg.Set use_fudged_width,
"use fudge factor for charge particle width";
"custom_width", Arg.String (fun f -> default_width := Custom f),
"use custom width";
"cancel_widths", Arg.Unit (fun () -> default_width := Vanishing),
"use vanishing width"]
type matter_field = L of int | N of int | U of int | D of int
type gauge_boson = Ga | Wp | Wm | Z | Gl
type other = Phip | Phim | Phi0 | H
type flavor = M of matter_field | G of gauge_boson | O of other
let matter_field f = M f
let gauge_boson f = G f
let other f = O f
type field =
| Matter of matter_field
| Gauge of gauge_boson
| Other of other
let field = function
| M f -> Matter f
| G f -> Gauge f
| O f -> Other f
type gauge = unit
let gauge_symbol () =
failwith "Modellib.SM.gauge_symbol: internal error"
let family n = List.map matter_field [ L n; N n; U n; D n ]
let external_flavors () =
[ "1st Generation", ThoList.flatmap family [1; -1];
"2nd Generation", ThoList.flatmap family [2; -2];
"3rd Generation", ThoList.flatmap family [3; -3];
"Gauge Bosons", List.map gauge_boson [Ga; Z; Wp; Wm; Gl];
"Higgs", List.map other [H];
"Goldstone Bosons", List.map other [Phip; Phim; Phi0] ]
let flavors () = ThoList.flatmap snd (external_flavors ())
let spinor n =
if n >= 0 then
Spinor
else
ConjSpinor
let lorentz = function
| M f ->
begin match f with
| L n -> spinor n | N n -> spinor n
| U n -> spinor n | D n -> spinor n
end
| G f ->
begin match f with
| Ga | Gl -> Vector
| Wp | Wm | Z -> Massive_Vector
end
| O f -> Scalar
let color = function
| M (U n) -> Color.SUN (if n > 0 then 3 else -3)
| M (D n) -> Color.SUN (if n > 0 then 3 else -3)
| G Gl -> Color.AdjSUN 3
| _ -> Color.Singlet
let prop_spinor n =
if n >= 0 then
Prop_Spinor
else
Prop_ConjSpinor
let propagator = function
| M f ->
begin match f with
| L n -> prop_spinor n | N n -> prop_spinor n
| U n -> prop_spinor n | D n -> prop_spinor n
end
| G f ->
begin match f with
| Ga | Gl -> Prop_Feynman
| Wp | Wm | Z -> Prop_Unitarity
end
| O f ->
begin match f with
| Phip | Phim | Phi0 -> Only_Insertion
| H -> Prop_Scalar
end
(* Optionally, ask for the fudge factor treatment for the widths of
charged particles. Currently, this only applies to $W^\pm$ and top. *)
let width f =
if !use_fudged_width then
match f with
| G Wp | G Wm | M (U 3) | M (U (-3)) -> Fudged
| _ -> !default_width
else
!default_width
let goldstone = function
| G f ->
begin match f with
| Wp -> Some (O Phip, Coupling.Const 1)
| Wm -> Some (O Phim, Coupling.Const 1)
| Z -> Some (O Phi0, Coupling.Const 1)
| _ -> None
end
| _ -> None
let conjugate = function
| M f ->
M (begin match f with
| L n -> L (-n) | N n -> N (-n)
| U n -> U (-n) | D n -> D (-n)
end)
| G f ->
G (begin match f with
| Gl -> Gl | Ga -> Ga | Z -> Z
| Wp -> Wm | Wm -> Wp
end)
| O f ->
O (begin match f with
| Phip -> Phim | Phim -> Phip | Phi0 -> Phi0
| H -> H
end)
let fermion = function
| M f ->
begin match f with
| L n -> if n > 0 then 1 else -1
| N n -> if n > 0 then 1 else -1
| U n -> if n > 0 then 1 else -1
| D n -> if n > 0 then 1 else -1
end
| G f ->
begin match f with
| Gl | Ga | Z | Wp | Wm -> 0
end
| O _ -> 0
(* Electrical charge, lepton number, baryon number. We could avoid the
rationals altogether by multiplying the first and last by 3 \ldots *)
module Ch = Charges.QQ
let ( // ) = Algebra.Small_Rational.make
let generation' = function
| 1 -> [ 1//1; 0//1; 0//1]
| 2 -> [ 0//1; 1//1; 0//1]
| 3 -> [ 0//1; 0//1; 1//1]
| -1 -> [-1//1; 0//1; 0//1]
| -2 -> [ 0//1; -1//1; 0//1]
| -3 -> [ 0//1; 0//1; -1//1]
| n -> invalid_arg ("SM.generation': " ^ string_of_int n)
let generation f =
if Flags.ckm_present then
[]
else
match f with
| M (L n | N n | U n | D n) -> generation' n
| G _ | O _ -> [0//1; 0//1; 0//1]
let charge = function
| M f ->
begin match f with
| L n -> if n > 0 then -1//1 else 1//1
| N n -> 0//1
| U n -> if n > 0 then 2//3 else -2//3
| D n -> if n > 0 then -1//3 else 1//3
end
| G f ->
begin match f with
| Gl | Ga | Z -> 0//1
| Wp -> 1//1
| Wm -> -1//1
end
| O f ->
begin match f with
| H | Phi0 -> 0//1
| Phip -> 1//1
| Phim -> -1//1
end
let lepton = function
| M f ->
begin match f with
| L n | N n -> if n > 0 then 1//1 else -1//1
| U _ | D _ -> 0//1
end
| G _ | O _ -> 0//1
let baryon = function
| M f ->
begin match f with
| L _ | N _ -> 0//1
| U n | D n -> if n > 0 then 1//1 else -1//1
end
| G _ | O _ -> 0//1
let charges f =
[ charge f; lepton f; baryon f] @ generation f
type constant =
| Unit | Pi | Alpha_QED | Sin2thw
| Sinthw | Costhw | E | G_weak | Vev
| Q_lepton | Q_up | Q_down | G_CC | G_CCQ of int*int
| G_NC_neutrino | G_NC_lepton | G_NC_up | G_NC_down
| I_Q_W | I_G_ZWW
| G_WWWW | G_ZZWW | G_AZWW | G_AAWW
| I_G1_AWW | I_G1_ZWW
| I_G1_plus_kappa_plus_G4_AWW
| I_G1_plus_kappa_plus_G4_ZWW
| I_G1_plus_kappa_minus_G4_AWW
| I_G1_plus_kappa_minus_G4_ZWW
| I_G1_minus_kappa_plus_G4_AWW
| I_G1_minus_kappa_plus_G4_ZWW
| I_G1_minus_kappa_minus_G4_AWW
| I_G1_minus_kappa_minus_G4_ZWW
| I_lambda_AWW | I_lambda_ZWW
| G5_AWW | G5_ZWW
| I_kappa5_AWW | I_kappa5_ZWW
| I_lambda5_AWW | I_lambda5_ZWW
| Alpha_WWWW0 | Alpha_ZZWW1 | Alpha_WWWW2
| Alpha_ZZWW0 | Alpha_ZZZZ
| D_Alpha_ZZWW0_S | D_Alpha_ZZWW0_T | D_Alpha_ZZWW1_S
| D_Alpha_ZZWW1_T | D_Alpha_ZZWW1_U | D_Alpha_WWWW0_S
| D_Alpha_WWWW0_T | D_Alpha_WWWW0_U | D_Alpha_WWWW2_S
| D_Alpha_WWWW2_T | D_Alpha_ZZZZ_S | D_Alpha_ZZZZ_T
| G_HWW | G_HHWW | G_HZZ | G_HHZZ
| G_Htt | G_Hbb | G_Hcc | G_Hmm | G_Htautau | G_H3 | G_H4
| G_HGaZ | G_HGaGa | G_Hgg
| Gs | I_Gs | G2
| Mass of flavor | Width of flavor
| K_Matrix_Coeff of int | K_Matrix_Pole of int
(* \begin{dubious}
The current abstract syntax for parameter dependencies is admittedly
tedious. Later, there will be a parser for a convenient concrete syntax
as a part of a concrete syntax for models. But as these examples show,
it should include simple functions.
\end{dubious} *)
(* \begin{subequations}
\begin{align}
\alpha_{\text{QED}} &= \frac{1}{137.0359895} \\
\sin^2\theta_w &= 0.23124
\end{align}
\end{subequations} *)
let input_parameters =
[ Alpha_QED, 1. /. 137.0359895;
Sin2thw, 0.23124;
Mass (G Z), 91.187;
Mass (M (N 1)), 0.0; Mass (M (L 1)), 0.51099907e-3;
Mass (M (N 2)), 0.0; Mass (M (L 2)), 0.105658389;
Mass (M (N 3)), 0.0; Mass (M (L 3)), 1.77705;
Mass (M (U 1)), 5.0e-3; Mass (M (D 1)), 3.0e-3;
Mass (M (U 2)), 1.2; Mass (M (D 2)), 0.1;
Mass (M (U 3)), 174.0; Mass (M (D 3)), 4.2 ]
(* \begin{subequations}
\begin{align}
e &= \sqrt{4\pi\alpha} \\
\sin\theta_w &= \sqrt{\sin^2\theta_w} \\
\cos\theta_w &= \sqrt{1-\sin^2\theta_w} \\
g &= \frac{e}{\sin\theta_w} \\
m_W &= \cos\theta_w m_Z \\
v &= \frac{2m_W}{g} \\
g_{CC} =
-\frac{g}{2\sqrt2} &= -\frac{e}{2\sqrt2\sin\theta_w} \\
Q_{\text{lepton}} =
-q_{\text{lepton}}e &= e \\
Q_{\text{up}} =
-q_{\text{up}}e &= -\frac{2}{3}e \\
Q_{\text{down}} =
-q_{\text{down}}e &= \frac{1}{3}e \\
\ii q_We =
\ii g_{\gamma WW} &= \ii e \\
\ii g_{ZWW} &= \ii g \cos\theta_w \\
\ii g_{WWW} &= \ii g
\end{align}
\end{subequations} *)
(* \begin{dubious}
\ldots{} to be continued \ldots{}
The quartic couplings can't be correct, because the dimensions are wrong!
\begin{subequations}
\begin{align}
g_{HWW} &= g m_W = 2 \frac{m_W^2}{v}\\
g_{HHWW} &= 2 \frac{m_W^2}{v^2} = \frac{g^2}{2} \\
g_{HZZ} &= \frac{g}{\cos\theta_w}m_Z \\
g_{HHZZ} &= 2 \frac{m_Z^2}{v^2} = \frac{g^2}{2\cos\theta_w} \\
g_{Htt} &= \lambda_t \\
g_{Hbb} &= \lambda_b=\frac{m_b}{m_t}\lambda_t \\
g_{H^3} &= - \frac{3g}{2}\frac{m_H^2}{m_W} = - 3 \frac{m_H^2}{v}
g_{H^4} &= - \frac{3g^2}{4} \frac{m_W^2}{v^2} = -3 \frac{m_H^2}{v^2}
\end{align}
\end{subequations}
\end{dubious} *)
let derived_parameters =
[ Real E, Sqrt (Prod [Const 4; Atom Pi; Atom Alpha_QED]);
Real Sinthw, Sqrt (Atom Sin2thw);
Real Costhw, Sqrt (Diff (Const 1, Atom Sin2thw));
Real G_weak, Quot (Atom E, Atom Sinthw);
Real (Mass (G Wp)), Prod [Atom Costhw; Atom (Mass (G Z))];
Real Vev, Quot (Prod [Const 2; Atom (Mass (G Wp))], Atom G_weak);
Real Q_lepton, Atom E;
Real Q_up, Prod [Quot (Const (-2), Const 3); Atom E];
Real Q_down, Prod [Quot (Const 1, Const 3); Atom E];
Real G_CC, Neg (Quot (Atom G_weak, Prod [Const 2; Sqrt (Const 2)]));
Complex I_Q_W, Prod [I; Atom E];
Complex I_G_ZWW, Prod [I; Atom G_weak; Atom Costhw]]
(* \begin{equation}
- \frac{g}{2\cos\theta_w}
\end{equation} *)
let g_over_2_costh =
Quot (Neg (Atom G_weak), Prod [Const 2; Atom Costhw])
(* \begin{subequations}
\begin{align}
- \frac{g}{2\cos\theta_w} g_V
&= - \frac{g}{2\cos\theta_w} (T_3 - 2 q \sin^2\theta_w) \\
- \frac{g}{2\cos\theta_w} g_A
&= - \frac{g}{2\cos\theta_w} T_3
\end{align}
\end{subequations} *)
let nc_coupling c t3 q =
(Real_Array c,
[Prod [g_over_2_costh; Diff (t3, Prod [Const 2; q; Atom Sin2thw])];
Prod [g_over_2_costh; t3]])
let half = Quot (Const 1, Const 2)
let derived_parameter_arrays =
[ nc_coupling G_NC_neutrino half (Const 0);
nc_coupling G_NC_lepton (Neg half) (Const (-1));
nc_coupling G_NC_up half (Quot (Const 2, Const 3));
nc_coupling G_NC_down (Neg half) (Quot (Const (-1), Const 3)) ]
let parameters () =
{ input = input_parameters;
derived = derived_parameters;
derived_arrays = derived_parameter_arrays }
module F = Modeltools.Fusions (struct
type f = flavor
type c = constant
let compare = compare
let conjugate = conjugate
end)
(* \begin{equation}
\mathcal{L}_{\textrm{EM}} =
- e \sum_i q_i \bar\psi_i\fmslash{A}\psi_i
\end{equation} *)
let mgm ((m1, g, m2), fbf, c) = ((M m1, G g, M m2), fbf, c)
let electromagnetic_currents n =
List.map mgm
[ ((L (-n), Ga, L n), FBF (1, Psibar, V, Psi), Q_lepton);
((U (-n), Ga, U n), FBF (1, Psibar, V, Psi), Q_up);
((D (-n), Ga, D n), FBF (1, Psibar, V, Psi), Q_down) ]
let color_currents n =
List.map mgm
[ ((U (-n), Gl, U n), FBF ((-1), Psibar, V, Psi), Gs);
((D (-n), Gl, D n), FBF ((-1), Psibar, V, Psi), Gs) ]
(* \begin{equation}
\mathcal{L}_{\textrm{NC}} =
- \frac{g}{2\cos\theta_W}
\sum_i \bar\psi_i\fmslash{Z}(g_V^i-g_A^i\gamma_5)\psi_i
\end{equation} *)
let neutral_currents n =
List.map mgm
[ ((L (-n), Z, L n), FBF (1, Psibar, VA, Psi), G_NC_lepton);
((N (-n), Z, N n), FBF (1, Psibar, VA, Psi), G_NC_neutrino);
((U (-n), Z, U n), FBF (1, Psibar, VA, Psi), G_NC_up);
((D (-n), Z, D n), FBF (1, Psibar, VA, Psi), G_NC_down) ]
(* \begin{equation}
\mathcal{L}_{\textrm{CC}} =
- \frac{g}{2\sqrt2} \sum_i \bar\psi_i
(T^+\fmslash{W}^+ + T^-\fmslash{W}^-)(1-\gamma_5)\psi_i
\end{equation} *)
let charged_currents' n =
List.map mgm
[ ((L (-n), Wm, N n), FBF (1, Psibar, VL, Psi), G_CC);
((N (-n), Wp, L n), FBF (1, Psibar, VL, Psi), G_CC) ]
let charged_currents'' n =
List.map mgm
[ ((D (-n), Wm, U n), FBF (1, Psibar, VL, Psi), G_CC);
((U (-n), Wp, D n), FBF (1, Psibar, VL, Psi), G_CC) ]
let charged_currents_triv =
ThoList.flatmap charged_currents' [1;2;3] @
ThoList.flatmap charged_currents'' [1;2;3]
let charged_currents_ckm =
let charged_currents_2 n1 n2 =
List.map mgm
[ ((D (-n1), Wm, U n2), FBF (1, Psibar, VL, Psi), G_CCQ (n2,n1));
((U (-n1), Wp, D n2), FBF (1, Psibar, VL, Psi), G_CCQ (n1,n2)) ] in
ThoList.flatmap charged_currents' [1;2;3] @
List.flatten (Product.list2 charged_currents_2 [1;2;3] [1;2;3])
let yukawa =
[ ((M (U (-3)), O H, M (U 3)), FBF (1, Psibar, S, Psi), G_Htt);
((M (D (-3)), O H, M (D 3)), FBF (1, Psibar, S, Psi), G_Hbb);
((M (U (-2)), O H, M (U 2)), FBF (1, Psibar, S, Psi), G_Hcc);
((M (L (-2)), O H, M (L 2)), FBF (1, Psibar, S, Psi), G_Hmm);
((M (L (-3)), O H, M (L 3)), FBF (1, Psibar, S, Psi), G_Htautau) ]
(* \begin{equation}
\mathcal{L}_{\textrm{TGC}} =
- e \partial_\mu A_\nu W_+^\mu W_-^\nu + \ldots
- e \cot\theta_w \partial_\mu Z_\nu W_+^\mu W_-^\nu + \ldots
\end{equation} *)
let tgc ((g1, g2, g3), t, c) = ((G g1, G g2, G g3), t, c)
let standard_triple_gauge =
List.map tgc
[ ((Ga, Wm, Wp), Gauge_Gauge_Gauge 1, I_Q_W);
((Z, Wm, Wp), Gauge_Gauge_Gauge 1, I_G_ZWW);
((Gl, Gl, Gl), Gauge_Gauge_Gauge 1, I_Gs)]
let anomalous_triple_gauge =
List.map tgc
[ ((Ga, Wm, Wp), Dim4_Vector_Vector_Vector_T (-1),
I_G1_AWW);
((Z, Wm, Wp), Dim4_Vector_Vector_Vector_T (-1),
I_G1_ZWW);
((Wm, Ga, Wp), Dim4_Vector_Vector_Vector_T 1,
I_G1_plus_kappa_minus_G4_AWW);
((Wm, Z, Wp), Dim4_Vector_Vector_Vector_T 1,
I_G1_plus_kappa_minus_G4_ZWW);
((Wp, Ga, Wm), Dim4_Vector_Vector_Vector_T (-1),
I_G1_plus_kappa_plus_G4_AWW);
((Wp, Z, Wm), Dim4_Vector_Vector_Vector_T (-1),
I_G1_plus_kappa_plus_G4_ZWW);
((Wm, Ga, Wp), Dim4_Vector_Vector_Vector_L (-1),
I_G1_minus_kappa_plus_G4_AWW);
((Wm, Z, Wp), Dim4_Vector_Vector_Vector_L (-1),
I_G1_minus_kappa_plus_G4_ZWW);
((Wp, Ga, Wm), Dim4_Vector_Vector_Vector_L 1,
I_G1_minus_kappa_minus_G4_AWW);
((Wp, Z, Wm), Dim4_Vector_Vector_Vector_L 1,
I_G1_minus_kappa_minus_G4_ZWW);
((Ga, Wm, Wp), Dim4_Vector_Vector_Vector_T5 (-1),
I_kappa5_AWW);
((Z, Wm, Wp), Dim4_Vector_Vector_Vector_T5 (-1),
I_kappa5_ZWW);
((Ga, Wm, Wp), Dim4_Vector_Vector_Vector_L5 (-1),
G5_AWW);
((Z, Wm, Wp), Dim4_Vector_Vector_Vector_L5 (-1),
G5_ZWW);
((Ga, Wp, Wm), Dim6_Gauge_Gauge_Gauge (-1),
I_lambda_AWW);
((Z, Wp, Wm), Dim6_Gauge_Gauge_Gauge (-1),
I_lambda_ZWW);
((Ga, Wp, Wm), Dim6_Gauge_Gauge_Gauge_5 (-1),
I_lambda5_AWW);
((Z, Wp, Wm), Dim6_Gauge_Gauge_Gauge_5 (-1),
I_lambda5_ZWW) ]
let triple_gauge =
if Flags.triple_anom then
anomalous_triple_gauge
else
standard_triple_gauge
(* \begin{equation}
\mathcal{L}_{\textrm{QGC}} =
- g^2 W_{+,\mu} W_{-,\nu} W_+^\mu W_-^\nu + \ldots
\end{equation} *)
(* Actually, quartic gauge couplings are a little bit more straightforward
using auxiliary fields. Here we have to impose the antisymmetry manually:
\begin{subequations}
\begin{multline}
(W^{+,\mu}_1 W^{-,\nu}_2 - W^{+,\nu}_1 W^{-,\mu}_2)
(W^+_{3,\mu} W^-_{4,\nu} - W^+_{3,\nu} W^-_{4,\mu}) \\
= 2(W^+_1W^+_3)(W^-_2W^-_4) - 2(W^+_1W^-_4)(W^-_2W^+_3)
\end{multline}
also ($V$ can be $A$ or $Z$)
\begin{multline}
(W^{+,\mu}_1 V^\nu_2 - W^{+,\nu}_1 V^\mu_2)
(W^-_{3,\mu} V_{4,\nu} - W^-_{3,\nu} V_{4,\mu}) \\
= 2(W^+_1W^-_3)(V_2V_4) - 2(W^+_1V_4)(V_2W^-_3)
\end{multline}
\end{subequations} *)
(* \begin{subequations}
\begin{multline}
W^{+,\mu} W^{-,\nu} W^+_\mu W^-_\nu
\end{multline}
\end{subequations} *)
let qgc ((g1, g2, g3, g4), t, c) = ((G g1, G g2, G g3, G g4), t, c)
let gauge4 = Vector4 [(2, C_13_42); (-1, C_12_34); (-1, C_14_23)]
let minus_gauge4 = Vector4 [(-2, C_13_42); (1, C_12_34); (1, C_14_23)]
let standard_quartic_gauge =
List.map qgc
[ (Wm, Wp, Wm, Wp), gauge4, G_WWWW;
(Wm, Z, Wp, Z), minus_gauge4, G_ZZWW;
(Wm, Z, Wp, Ga), minus_gauge4, G_AZWW;
(Wm, Ga, Wp, Ga), minus_gauge4, G_AAWW;
(Gl, Gl, Gl, Gl), gauge4, G2 ]
(* \begin{subequations}
\begin{align}
\mathcal{L}_4
&= \alpha_4 \left( \frac{g^4}{2}\left( (W^+_\mu W^{-,\mu})^2
+ W^+_\mu W^{+,\mu} W^-_\mu W^{-,\mu}
\right)\right.\notag \\
&\qquad\qquad\qquad \left.
+ \frac{g^4}{\cos^2\theta_w} W^+_\mu Z^\mu W^-_\nu Z^\nu
+ \frac{g^4}{4\cos^4\theta_w} (Z_\mu Z^\mu)^2 \right) \\
\mathcal{L}_5
&= \alpha_5 \left( g^4 (W^+_\mu W^{-,\mu})^2
+ \frac{g^4}{\cos^2\theta_w} W^+_\mu W^{-,\mu} Z_\nu Z^\nu
+ \frac{g^4}{4\cos^4\theta_w} (Z_\mu Z^\mu)^2 \right)
\end{align}
\end{subequations}
or
\begin{multline}
\mathcal{L}_4 + \mathcal{L}_5
= (\alpha_4+2\alpha_5) g^4 \frac{1}{2} (W^+_\mu W^{-,\mu})^2 \\
+ 2\alpha_4 g^4 \frac{1}{4} W^+_\mu W^{+,\mu} W^-_\mu W^{-,\mu}
+ \alpha_4 \frac{g^4}{\cos^2\theta_w} W^+_\mu Z^\mu W^-_\nu Z^\nu \\
+ 2\alpha_5 \frac{g^4}{\cos^2\theta_w} \frac{1}{2} W^+_\mu W^{-,\mu} Z_\nu Z^\nu
+ (2\alpha_4 + 2\alpha_5) \frac{g^4}{\cos^4\theta_w} \frac{1}{8} (Z_\mu Z^\mu)^2
\end{multline}
and therefore
\begin{subequations}
\begin{align}
\alpha_{(WW)_0} &= (\alpha_4+2\alpha_5) g^4 \\
\alpha_{(WW)_2} &= 2\alpha_4 g^4 \\
\alpha_{(WZ)_0} &= 2\alpha_5 \frac{g^4}{\cos^2\theta_w} \\
\alpha_{(WZ)_1} &= \alpha_4 \frac{g^4}{\cos^2\theta_w} \\
\alpha_{ZZ} &= (2\alpha_4 + 2\alpha_5) \frac{g^4}{\cos^4\theta_w}
\end{align}
\end{subequations} *)
let anomalous_quartic_gauge =
if Flags.quartic_anom then
List.map qgc
[ ((Wm, Wm, Wp, Wp),
Vector4 [(1, C_13_42); (1, C_14_23)], Alpha_WWWW0);
((Wm, Wm, Wp, Wp),
Vector4 [1, C_12_34], Alpha_WWWW2);
((Wm, Wp, Z, Z),
Vector4 [1, C_12_34], Alpha_ZZWW0);
((Wm, Wp, Z, Z),
Vector4 [(1, C_13_42); (1, C_14_23)], Alpha_ZZWW1);
((Z, Z, Z, Z),
Vector4 [(1, C_12_34); (1, C_13_42); (1, C_14_23)], Alpha_ZZZZ) ]
else
[]
(* In any diagonal channel~$\chi$, the scattering amplitude~$a_\chi(s)$ is
unitary iff\footnote{%
Trivial proof:
\begin{equation}
-1 = \textrm{Im}\left(\frac{1}{a_\chi(s)}\right)
= \frac{\textrm{Im}(a_\chi^*(s))}{|a_\chi(s)|^2}
= - \frac{\textrm{Im}(a_\chi(s))}{|a_\chi(s)|^2}
\end{equation}
i.\,e.~$\textrm{Im}(a_\chi(s)) = |a_\chi(s)|^2$.}
\begin{equation}
\textrm{Im}\left(\frac{1}{a_\chi(s)}\right) = -1
\end{equation}
For a real perturbative scattering amplitude~$r_\chi(s)$ this can be
enforced easily--and arbitrarily--by
\begin{equation}
\frac{1}{a_\chi(s)} = \frac{1}{r_\chi(s)} - \mathrm{i}
\end{equation}
*)
let k_matrix_quartic_gauge =
if Flags.k_matrix then
List.map qgc
[ ((Wm, Wp, Wm, Wp), Vector4_K_Matrix_jr (0,
[(1, C_12_34)]), D_Alpha_WWWW0_S);
((Wm, Wp, Wm, Wp), Vector4_K_Matrix_jr (0,
[(1, C_14_23)]), D_Alpha_WWWW0_T);
((Wm, Wp, Wm, Wp), Vector4_K_Matrix_jr (0,
[(1, C_13_42)]), D_Alpha_WWWW0_U);
((Wp, Wm, Wp, Wm), Vector4_K_Matrix_jr (0,
[(1, C_12_34)]), D_Alpha_WWWW0_S);
((Wp, Wm, Wp, Wm), Vector4_K_Matrix_jr (0,
[(1, C_14_23)]), D_Alpha_WWWW0_T);
((Wp, Wm, Wp, Wm), Vector4_K_Matrix_jr (0,
[(1, C_13_42)]), D_Alpha_WWWW0_U);
((Wm, Wm, Wp, Wp), Vector4_K_Matrix_jr (0,
[(1, C_12_34)]), D_Alpha_WWWW2_S);
((Wm, Wm, Wp, Wp), Vector4_K_Matrix_jr (0,
[(1, C_13_42); (1, C_14_23)]), D_Alpha_WWWW2_T);
((Wm, Wp, Z, Z), Vector4_K_Matrix_jr (0,
[(1, C_12_34)]), D_Alpha_ZZWW0_S);
((Wm, Wp, Z, Z), Vector4_K_Matrix_jr (0,
[(1, C_13_42); (1, C_14_23)]), D_Alpha_ZZWW0_T);
((Wm, Z, Wp, Z), Vector4_K_Matrix_jr (0,
[(1, C_12_34)]), D_Alpha_ZZWW1_S);
((Wm, Z, Wp, Z), Vector4_K_Matrix_jr (0,
[(1, C_13_42)]), D_Alpha_ZZWW1_T);
((Wm, Z, Wp, Z), Vector4_K_Matrix_jr (0,
[(1, C_14_23)]), D_Alpha_ZZWW1_U);
((Wp, Z, Z, Wm), Vector4_K_Matrix_jr (1,
[(1, C_12_34)]), D_Alpha_ZZWW1_S);
((Wp, Z, Z, Wm), Vector4_K_Matrix_jr (1,
[(1, C_13_42)]), D_Alpha_ZZWW1_U);
((Wp, Z, Z, Wm), Vector4_K_Matrix_jr (1,
[(1, C_14_23)]), D_Alpha_ZZWW1_T);
((Z, Wp, Wm, Z), Vector4_K_Matrix_jr (2,
[(1, C_12_34)]), D_Alpha_ZZWW1_S);
((Z, Wp, Wm, Z), Vector4_K_Matrix_jr (2,
[(1, C_13_42)]), D_Alpha_ZZWW1_U);
((Z, Wp, Wm, Z), Vector4_K_Matrix_jr (2,
[(1, C_14_23)]), D_Alpha_ZZWW1_T);
((Z, Z, Z, Z), Vector4_K_Matrix_jr (0,
[(1, C_12_34)]), D_Alpha_ZZZZ_S);
((Z, Z, Z, Z), Vector4_K_Matrix_jr (0,
[(1, C_13_42); (1, C_14_23)]), D_Alpha_ZZZZ_T);
((Z, Z, Z, Z), Vector4_K_Matrix_jr (3,
[(1, C_14_23)]), D_Alpha_ZZZZ_S);
((Z, Z, Z, Z), Vector4_K_Matrix_jr (3,
[(1, C_13_42); (1, C_12_34)]), D_Alpha_ZZZZ_T) ]
else
[]
(*i Thorsten's original implementation of the K matrix, which we keep since
it still might be usefull for the future.
let k_matrix_quartic_gauge =
if Flags.k_matrix then
List.map qgc
[ ((Wm, Wp, Wm, Wp), Vector4_K_Matrix_tho (true, [K_Matrix_Coeff 0,
K_Matrix_Pole 0]), Alpha_WWWW0);
((Wm, Wm, Wp, Wp), Vector4_K_Matrix_tho (true, [K_Matrix_Coeff 2,
K_Matrix_Pole 2]), Alpha_WWWW2);
((Wm, Wp, Z, Z), Vector4_K_Matrix_tho (true, [(K_Matrix_Coeff 0,
K_Matrix_Pole 0); (K_Matrix_Coeff 2,
K_Matrix_Pole 2)]), Alpha_ZZWW0);
((Wm, Z, Wp, Z), Vector4_K_Matrix_tho (true, [K_Matrix_Coeff 1,
K_Matrix_Pole 1]), Alpha_ZZWW1);
((Z, Z, Z, Z), Vector4_K_Matrix_tho (0, [K_Matrix_Coeff 0,
K_Matrix_Pole 0]), Alpha_ZZZZ) ]
else
[]
i*)
let quartic_gauge =
standard_quartic_gauge @ anomalous_quartic_gauge @ k_matrix_quartic_gauge
let standard_gauge_higgs =
[ ((O H, G Wp, G Wm), Scalar_Vector_Vector 1, G_HWW);
((O H, G Z, G Z), Scalar_Vector_Vector 1, G_HZZ) ]
let standard_gauge_higgs4 =
[ (O H, O H, G Wp, G Wm), Scalar2_Vector2 1, G_HHWW;
(O H, O H, G Z, G Z), Scalar2_Vector2 1, G_HHZZ ]
let standard_higgs =
[ (O H, O H, O H), Scalar_Scalar_Scalar 1, G_H3 ]
let standard_higgs4 =
[ (O H, O H, O H, O H), Scalar4 1, G_H4 ]
(* WK's couplings (apparently, he still intends to divide by
$\Lambda^2_{\text{EWSB}}=16\pi^2v_{\mathrm{F}}^2$):
\begin{subequations}
\begin{align}
\mathcal{L}^{\tau}_4 &=
\left\lbrack (\partial_{\mu}H)(\partial^{\mu}H)
+ \frac{g^2v_{\mathrm{F}}^2}{4} V_{\mu} V^{\mu} \right\rbrack^2 \\
\mathcal{L}^{\tau}_5 &=
\left\lbrack (\partial_{\mu}H)(\partial_{\nu}H)
+ \frac{g^2v_{\mathrm{F}}^2}{4} V_{\mu} V_{\nu} \right\rbrack^2
\end{align}
\end{subequations}
with
\begin{equation}
V_{\mu} V_{\nu} =
\frac{1}{2} \left( W^+_{\mu} W^-_{\nu} + W^+_{\nu} W^-_{\mu} \right)
+ \frac{1}{2\cos^2\theta_{w}} Z_{\mu} Z_{\nu}
\end{equation}
(note the symmetrization!), i.\,e.
\begin{subequations}
\begin{align}
\mathcal{L}_4 &= \alpha_4 \frac{g^4v_{\mathrm{F}}^4}{16} (V_{\mu} V_{\nu})^2 \\
\mathcal{L}_5 &= \alpha_5 \frac{g^4v_{\mathrm{F}}^4}{16} (V_{\mu} V^{\mu})^2
\end{align}
\end{subequations} *)
(* Breaking thinks up
\begin{subequations}
\begin{align}
\mathcal{L}^{\tau,H^4}_4 &=
\left\lbrack (\partial_{\mu}H)(\partial^{\mu}H) \right\rbrack^2 \\
\mathcal{L}^{\tau,H^4}_5 &=
\left\lbrack (\partial_{\mu}H)(\partial^{\mu}H) \right\rbrack^2
\end{align}
\end{subequations}
and
\begin{subequations}
\begin{align}
\mathcal{L}^{\tau,H^2V^2}_4 &= \frac{g^2v_{\mathrm{F}}^2}{2}
(\partial_{\mu}H)(\partial^{\mu}H) V_{\mu}V^{\mu} \\
\mathcal{L}^{\tau,H^2V^2}_5 &= \frac{g^2v_{\mathrm{F}}^2}{2}
(\partial_{\mu}H)(\partial_{\nu}H) V_{\mu}V_{\nu}
\end{align}
\end{subequations}
i.\,e.
\begin{subequations}
\begin{align}
\mathcal{L}^{\tau,H^2V^2}_4 &=
\frac{g^2v_{\mathrm{F}}^2}{2}
\left\lbrack
(\partial_{\mu}H)(\partial^{\mu}H) W^+_{\nu}W^{-,\nu}
+ \frac{1}{2\cos^2\theta_{w}} (\partial_{\mu}H)(\partial^{\mu}H) Z_{\nu} Z^{\nu}
\right\rbrack \\
\mathcal{L}^{\tau,H^2V^2}_5 &=
\frac{g^2v_{\mathrm{F}}^2}{2}
\left\lbrack
(W^{+,\mu}\partial_{\mu}H) (W^{-,\nu}\partial_{\nu}H)
+ \frac{1}{2\cos^2\theta_{w}} (Z^{\mu}\partial_{\mu}H)(Z^{\nu}\partial_{\nu}H)
\right\rbrack
\end{align}
\end{subequations} *)
(* \begin{multline}
\tau^4_8 \mathcal{L}^{\tau,H^2V^2}_4 + \tau^5_8 \mathcal{L}^{\tau,H^2V^2}_5 = \\
- \frac{g^2v_{\mathrm{F}}^2}{2} \Biggl\lbrack
2\tau^4_8
\frac{1}{2}(\ii\partial_{\mu}H)(\ii\partial^{\mu}H) W^+_{\nu}W^{-,\nu}
+ \tau^5_8
(W^{+,\mu}\ii\partial_{\mu}H) (W^{-,\nu}\ii\partial_{\nu}H) \\
+ \frac{2\tau^4_8}{\cos^2\theta_{w}}
\frac{1}{4} (\ii\partial_{\mu}H)(\ii\partial^{\mu}H) Z_{\nu} Z^{\nu}
+ \frac{\tau^5_8}{\cos^2\theta_{w}}
\frac{1}{2} (Z^{\mu}\ii\partial_{\mu}H)(Z^{\nu}\ii\partial_{\nu}H)
\Biggr\rbrack
\end{multline}
where the two powers of $\ii$ make the sign conveniently negative,
i.\,e.
\begin{subequations}
\begin{align}
\alpha_{(\partial H)^2W^2}^2 &= \tau^4_8 g^2v_{\mathrm{F}}^2\\
\alpha_{(\partial HW)^2}^2 &= \frac{\tau^5_8 g^2v_{\mathrm{F}}^2}{2} \\
\alpha_{(\partial H)^2Z^2}^2 &= \frac{\tau^4_8 g^2v_{\mathrm{F}}^2}{\cos^2\theta_{w}} \\
\alpha_{(\partial HZ)^2}^2 &=\frac{\tau^5_8 g^2v_{\mathrm{F}}^2}{2\cos^2\theta_{w}}
\end{align}
\end{subequations} *)
let anomalous_gauge_higgs =
[]
let anomalous_gauge_higgs4 =
[]
let anomalous_higgs =
[]
let higgs_triangle_vertices =
if Flags.higgs_triangle then
[ (O H, G Ga, G Ga), Dim5_Scalar_Gauge2 1, G_HGaGa;
(O H, G Ga, G Z), Dim5_Scalar_Gauge2 1, G_HGaZ;
(O H, G Gl, G Gl), Dim5_Scalar_Gauge2 1, G_Hgg ]
else
[]
let anomalous_higgs4 =
[]
let gauge_higgs =
if Flags.higgs_anom then
standard_gauge_higgs @ anomalous_gauge_higgs
else
standard_gauge_higgs
let gauge_higgs4 =
if Flags.higgs_anom then
standard_gauge_higgs4 @ anomalous_gauge_higgs4
else
standard_gauge_higgs4
let higgs =
if Flags.higgs_anom then
standard_higgs @ anomalous_higgs
else
standard_higgs
let higgs4 =
if Flags.higgs_anom then
standard_higgs4 @ anomalous_higgs4
else
standard_higgs4
let goldstone_vertices =
[ ((O Phi0, G Wm, G Wp), Scalar_Vector_Vector 1, I_G_ZWW);
((O Phip, G Ga, G Wm), Scalar_Vector_Vector 1, I_Q_W);
((O Phip, G Z, G Wm), Scalar_Vector_Vector 1, I_G_ZWW);
((O Phim, G Wp, G Ga), Scalar_Vector_Vector 1, I_Q_W);
((O Phim, G Wp, G Z), Scalar_Vector_Vector 1, I_G_ZWW) ]
let vertices3 =
(ThoList.flatmap electromagnetic_currents [1;2;3] @
ThoList.flatmap color_currents [1;2;3] @
ThoList.flatmap neutral_currents [1;2;3] @
(if Flags.ckm_present then
charged_currents_ckm
else
charged_currents_triv) @
yukawa @ triple_gauge @
gauge_higgs @ higgs @ higgs_triangle_vertices
@ goldstone_vertices)
let vertices4 =
quartic_gauge @ gauge_higgs4 @ higgs4
let vertices () = (vertices3, vertices4, [])
(* For efficiency, make sure that [F.of_vertices vertices] is
evaluated only once. *)
let table = F.of_vertices (vertices ())
let fuse2 = F.fuse2 table
let fuse3 = F.fuse3 table
let fuse = F.fuse table
let max_degree () = 4
let flavor_of_string = function
| "e-" -> M (L 1) | "e+" -> M (L (-1))
| "mu-" -> M (L 2) | "mu+" -> M (L (-2))
| "tau-" -> M (L 3) | "tau+" -> M (L (-3))
| "nue" -> M (N 1) | "nuebar" -> M (N (-1))
| "numu" -> M (N 2) | "numubar" -> M (N (-2))
| "nutau" -> M (N 3) | "nutaubar" -> M (N (-3))
| "u" -> M (U 1) | "ubar" -> M (U (-1))
| "c" -> M (U 2) | "cbar" -> M (U (-2))
| "t" -> M (U 3) | "tbar" -> M (U (-3))
| "d" -> M (D 1) | "dbar" -> M (D (-1))
| "s" -> M (D 2) | "sbar" -> M (D (-2))
| "b" -> M (D 3) | "bbar" -> M (D (-3))
| "g" | "gl" -> G Gl
| "A" -> G Ga | "Z" | "Z0" -> G Z
| "W+" -> G Wp | "W-" -> G Wm
| "H" -> O H
| _ -> invalid_arg "Modellib.SM.flavor_of_string"
let flavor_to_string = function
| M f ->
begin match f with
| L 1 -> "e-" | L (-1) -> "e+"
| L 2 -> "mu-" | L (-2) -> "mu+"
| L 3 -> "tau-" | L (-3) -> "tau+"
| L _ -> invalid_arg
"Modellib.SM.flavor_to_string: invalid lepton"
| N 1 -> "nue" | N (-1) -> "nuebar"
| N 2 -> "numu" | N (-2) -> "numubar"
| N 3 -> "nutau" | N (-3) -> "nutaubar"
| N _ -> invalid_arg
"Modellib.SM.flavor_to_string: invalid neutrino"
| U 1 -> "u" | U (-1) -> "ubar"
| U 2 -> "c" | U (-2) -> "cbar"
| U 3 -> "t" | U (-3) -> "tbar"
| U _ -> invalid_arg
"Modellib.SM.flavor_to_string: invalid up type quark"
| D 1 -> "d" | D (-1) -> "dbar"
| D 2 -> "s" | D (-2) -> "sbar"
| D 3 -> "b" | D (-3) -> "bbar"
| D _ -> invalid_arg
"Modellib.SM.flavor_to_string: invalid down type quark"
end
| G f ->
begin match f with
| Gl -> "gl"
| Ga -> "A" | Z -> "Z"
| Wp -> "W+" | Wm -> "W-"
end
| O f ->
begin match f with
| Phip -> "phi+" | Phim -> "phi-" | Phi0 -> "phi0"
| H -> "H"
end
let flavor_to_TeX = function
| M f ->
begin match f with
| L 1 -> "e^-" | L (-1) -> "e^+"
| L 2 -> "\\mu^-" | L (-2) -> "\\mu^+"
| L 3 -> "\\tau^-" | L (-3) -> "\\tau^+"
| L _ -> invalid_arg
"Modellib.SM.flavor_to_TeX: invalid lepton"
| N 1 -> "\\nu_e" | N (-1) -> "\\bar{\\nu}_e"
| N 2 -> "\\nu_\\mu" | N (-2) -> "\\bar{\\nu}_\\mu"
| N 3 -> "\\nu_\\tau" | N (-3) -> "\\bar{\\nu}_\\tau"
| N _ -> invalid_arg
"Modellib.SM.flavor_to_TeX: invalid neutrino"
| U 1 -> "u" | U (-1) -> "\\bar{u}"
| U 2 -> "c" | U (-2) -> "\\bar{c}"
| U 3 -> "t" | U (-3) -> "\\bar{t}"
| U _ -> invalid_arg
"Modellib.SM.flavor_to_TeX: invalid up type quark"
| D 1 -> "d" | D (-1) -> "\\bar{d}"
| D 2 -> "s" | D (-2) -> "\\bar{s}"
| D 3 -> "b" | D (-3) -> "\\bar{b}"
| D _ -> invalid_arg
"Modellib.SM.flavor_to_TeX: invalid down type quark"
end
| G f ->
begin match f with
| Gl -> "g"
| Ga -> "\\gamma" | Z -> "Z"
| Wp -> "W^+" | Wm -> "W^-"
end
| O f ->
begin match f with
| Phip -> "\\phi^+" | Phim -> "\\phi^-" | Phi0 -> "\\phi^0"
| H -> "H"
end
let flavor_symbol = function
| M f ->
begin match f with
| L n when n > 0 -> "l" ^ string_of_int n
| L n -> "l" ^ string_of_int (abs n) ^ "b"
| N n when n > 0 -> "n" ^ string_of_int n
| N n -> "n" ^ string_of_int (abs n) ^ "b"
| U n when n > 0 -> "u" ^ string_of_int n
| U n -> "u" ^ string_of_int (abs n) ^ "b"
| D n when n > 0 -> "d" ^ string_of_int n
| D n -> "d" ^ string_of_int (abs n) ^ "b"
end
| G f ->
begin match f with
| Gl -> "gl"
| Ga -> "a" | Z -> "z"
| Wp -> "wp" | Wm -> "wm"
end
| O f ->
begin match f with
| Phip -> "pp" | Phim -> "pm" | Phi0 -> "p0"
| H -> "h"
end
let pdg = function
| M f ->
begin match f with
| L n when n > 0 -> 9 + 2*n
| L n -> - 9 + 2*n
| N n when n > 0 -> 10 + 2*n
| N n -> - 10 + 2*n
| U n when n > 0 -> 2*n
| U n -> 2*n
| D n when n > 0 -> - 1 + 2*n
| D n -> 1 + 2*n
end
| G f ->
begin match f with
| Gl -> 21
| Ga -> 22 | Z -> 23
| Wp -> 24 | Wm -> (-24)
end
| O f ->
begin match f with
| Phip | Phim -> 27 | Phi0 -> 26
| H -> 25
end
let mass_symbol f =
"mass(" ^ string_of_int (abs (pdg f)) ^ ")"
let width_symbol f =
"width(" ^ string_of_int (abs (pdg f)) ^ ")"
let constant_symbol = function
| Unit -> "unit" | Pi -> "PI"
| Alpha_QED -> "alpha" | E -> "e" | G_weak -> "g" | Vev -> "vev"
| Sin2thw -> "sin2thw" | Sinthw -> "sinthw" | Costhw -> "costhw"
| Q_lepton -> "qlep" | Q_up -> "qup" | Q_down -> "qdwn"
| G_NC_lepton -> "gnclep" | G_NC_neutrino -> "gncneu"
| G_NC_up -> "gncup" | G_NC_down -> "gncdwn"
| G_CC -> "gcc"
| G_CCQ (n1,n2) -> "gccq" ^ string_of_int n1 ^ string_of_int n2
| I_Q_W -> "iqw" | I_G_ZWW -> "igzww"
| G_WWWW -> "gw4" | G_ZZWW -> "gzzww"
| G_AZWW -> "gazww" | G_AAWW -> "gaaww"
| I_G1_AWW -> "ig1a" | I_G1_ZWW -> "ig1z"
| I_G1_plus_kappa_plus_G4_AWW -> "ig1pkpg4a"
| I_G1_plus_kappa_plus_G4_ZWW -> "ig1pkpg4z"
| I_G1_plus_kappa_minus_G4_AWW -> "ig1pkmg4a"
| I_G1_plus_kappa_minus_G4_ZWW -> "ig1pkmg4z"
| I_G1_minus_kappa_plus_G4_AWW -> "ig1mkpg4a"
| I_G1_minus_kappa_plus_G4_ZWW -> "ig1mkpg4z"
| I_G1_minus_kappa_minus_G4_AWW -> "ig1mkmg4a"
| I_G1_minus_kappa_minus_G4_ZWW -> "ig1mkmg4z"
| I_lambda_AWW -> "ila"
| I_lambda_ZWW -> "ilz"
| G5_AWW -> "rg5a"
| G5_ZWW -> "rg5z"
| I_kappa5_AWW -> "ik5a"
| I_kappa5_ZWW -> "ik5z"
| I_lambda5_AWW -> "il5a" | I_lambda5_ZWW -> "il5z"
| Alpha_WWWW0 -> "alww0" | Alpha_WWWW2 -> "alww2"
| Alpha_ZZWW0 -> "alzw0" | Alpha_ZZWW1 -> "alzw1"
| Alpha_ZZZZ -> "alzz"
| D_Alpha_ZZWW0_S -> "dalzz0_s(gkm,mkm,"
| D_Alpha_ZZWW0_T -> "dalzz0_t(gkm,mkm,"
| D_Alpha_ZZWW1_S -> "dalzz1_s(gkm,mkm,"
| D_Alpha_ZZWW1_T -> "dalzz1_t(gkm,mkm,"
| D_Alpha_ZZWW1_U -> "dalzz1_u(gkm,mkm,"
| D_Alpha_WWWW0_S -> "dalww0_s(gkm,mkm,"
| D_Alpha_WWWW0_T -> "dalww0_t(gkm,mkm,"
| D_Alpha_WWWW0_U -> "dalww0_u(gkm,mkm,"
| D_Alpha_WWWW2_S -> "dalww2_s(gkm,mkm,"
| D_Alpha_WWWW2_T -> "dalww2_t(gkm,mkm,"
| D_Alpha_ZZZZ_S -> "dalz4_s(gkm,mkm,"
| D_Alpha_ZZZZ_T -> "dalz4_t(gkm,mkm,"
| G_HWW -> "ghww" | G_HZZ -> "ghzz"
| G_HHWW -> "ghhww" | G_HHZZ -> "ghhzz"
| G_Htt -> "ghtt" | G_Hbb -> "ghbb"
| G_Htautau -> "ghtautau" | G_Hcc -> "ghcc" | G_Hmm -> "ghmm"
| G_HGaZ -> "ghgaz" | G_HGaGa -> "ghgaga" | G_Hgg -> "ghgg"
| G_H3 -> "gh3" | G_H4 -> "gh4"
| Gs -> "gs" | I_Gs -> "igs" | G2 -> "gs**2"
| Mass f -> "mass" ^ flavor_symbol f
| Width f -> "width" ^ flavor_symbol f
| K_Matrix_Coeff i -> "kc" ^ string_of_int i
| K_Matrix_Pole i -> "kp" ^ string_of_int i
end
(* \thocwmodulesection{Incomplete Standard Model in $R_\xi$ Gauge} *)
(* \begin{dubious}
At the end of the day, we want a functor mapping from gauge models
in unitarity gauge to $R_\xi$ gauge and vice versa. For this, we
will need a more abstract implementation of (spontaneously broken)
gauge theories.
\end{dubious} *)
module SM_Rxi =
struct
let rcs = RCS.rename rcs_file "Modellib.SM_Rxi"
[ "minimal electroweak standard model in R-xi gauge";
"NB: very incomplete still!, no CKM matrix" ]
open Coupling
module SM = SM(SM_no_anomalous)
let options = SM.options
type flavor = SM.flavor
let flavors = SM.flavors
let external_flavors = SM.external_flavors
type constant = SM.constant
let lorentz = SM.lorentz
let color = SM.color
let goldstone = SM.goldstone
let conjugate = SM.conjugate
let fermion = SM.fermion
(* \begin{dubious}
Check if it makes sense to have separate gauge fixing parameters
for each vector boson. There's probably only one independent
parameter for each group factor.
\end{dubious} *)
type gauge =
| XiA | XiZ | XiW
let gauge_symbol = function
| XiA -> "xia" | XiZ -> "xi0" | XiW -> "xipm"
(* Change the gauge boson propagators and make the Goldstone bosons
propagating. *)
let propagator = function
| SM.G SM.Ga -> Prop_Gauge XiA
| SM.G SM.Z -> Prop_Rxi XiZ
| SM.G SM.Wp | SM.G SM.Wm -> Prop_Rxi XiW
| SM.O SM.Phip | SM.O SM.Phim | SM.O SM.Phi0 -> Prop_Scalar
| f -> SM.propagator f
let width = SM.width
module Ch = Charges.QQ
- let charges _ = []
+ let charges = SM.charges
module F = Modeltools.Fusions (struct
type f = flavor
type c = constant
let compare = compare
let conjugate = conjugate
end)
let vertices = SM.vertices
let table = F.of_vertices (vertices ())
let fuse2 = F.fuse2 table
let fuse3 = F.fuse3 table
let fuse = F.fuse table
let max_degree () = 3
let parameters = SM.parameters
let flavor_of_string = SM.flavor_of_string
let flavor_to_string = SM.flavor_to_string
let flavor_to_TeX = SM.flavor_to_TeX
let flavor_symbol = SM.flavor_symbol
let pdg = SM.pdg
let mass_symbol = SM.mass_symbol
let width_symbol = SM.width_symbol
let constant_symbol = SM.constant_symbol
end
(* \thocwmodulesection{Groves} *)
module Groves (M : Model.Gauge) : Model.Gauge with module Ch = M.Ch =
struct
let max_generations = 5
let rcs = RCS.rename M.rcs
("Modellib.Groves(" ^ (RCS.name M.rcs) ^ ")")
([ "experimental Groves functor";
Printf.sprintf "for maximally %d flavored legs"
(2 * max_generations) ] @
RCS.description M.rcs)
let options = M.options
type matter_field = M.matter_field * int
type gauge_boson = M.gauge_boson
type other = M.other
type field =
| Matter of matter_field
| Gauge of gauge_boson
| Other of other
type flavor = M of matter_field | G of gauge_boson | O of other
let matter_field (f, g) = M (f, g)
let gauge_boson f = G f
let other f = O f
let field = function
| M f -> Matter f
| G f -> Gauge f
| O f -> Other f
let project = function
| M (f, _) -> M.matter_field f
| G f -> M.gauge_boson f
| O f -> M.other f
let inject g f =
match M.field f with
| M.Matter f -> M (f, g)
| M.Gauge f -> G f
| M.Other f -> O f
type gauge = M.gauge
let gauge_symbol = M.gauge_symbol
let color f = M.color (project f)
let pdg f = M.pdg (project f)
let lorentz f = M.lorentz (project f)
let propagator f = M.propagator (project f)
let fermion f = M.fermion (project f)
let width f = M.width (project f)
let mass_symbol f = M.mass_symbol (project f)
let width_symbol f = M.width_symbol (project f)
let flavor_symbol f = M.flavor_symbol (project f)
type constant = M.constant
let constant_symbol = M.constant_symbol
let max_degree = M.max_degree
let parameters = M.parameters
let conjugate = function
| M (_, g) as f -> inject g (M.conjugate (project f))
| f -> inject 0 (M.conjugate (project f))
let read_generation s =
try
let offset = String.index s '/' in
(int_of_string
(String.sub s (succ offset) (String.length s - offset - 1)),
String.sub s 0 offset)
with
| Not_found -> (1, s)
let format_generation c s =
s ^ "/" ^ string_of_int c
let flavor_of_string s =
let g, s = read_generation s in
inject g (M.flavor_of_string s)
let flavor_to_string = function
| M (_, g) as f -> format_generation g (M.flavor_to_string (project f))
| f -> M.flavor_to_string (project f)
let flavor_to_TeX = function
| M (_, g) as f -> format_generation g (M.flavor_to_TeX (project f))
| f -> M.flavor_to_TeX (project f)
let goldstone = function
| G _ as f ->
begin match M.goldstone (project f) with
| None -> None
| Some (f, c) -> Some (inject 0 f, c)
end
| M _ | O _ -> None
let clone generations flavor =
match M.field flavor with
| M.Matter f -> List.map (fun g -> M (f, g)) generations
| M.Gauge f -> [G f]
| M.Other f -> [O f]
let generations = ThoList.range 1 max_generations
let flavors () =
ThoList.flatmap (clone generations) (M.flavors ())
let external_flavors () =
List.map (fun (s, fl) -> (s, ThoList.flatmap (clone generations) fl))
(M.external_flavors ())
module Ch = M.Ch
let charges f = M.charges (project f)
module F = Modeltools.Fusions (struct
type f = flavor
type c = constant
let compare = compare
let conjugate = conjugate
end)
(* In the following functions, we might replace [_] by [(M.Gauge _ | M.Other _)],
in order to allow the compiler to check completeness. However, this
makes the code much less readable. *)
let clone3 ((f1, f2, f3), v, c) =
match M.field f1, M.field f2, M.field f3 with
| M.Matter _, M.Matter _, M.Matter _ ->
invalid_arg "Modellib.Groves().vertices: three matter fields!"
| M.Matter f1', M.Matter f2', _ ->
List.map (fun g -> ((M (f1', g), M (f2', g), inject 0 f3), v, c))
generations
| M.Matter f1', _, M.Matter f3' ->
List.map (fun g -> ((M (f1', g), inject 0 f2, M (f3', g)), v, c))
generations
| _, M.Matter f2', M.Matter f3' ->
List.map (fun g -> ((inject 0 f1, M (f2', g), M (f3', g)), v, c))
generations
| M.Matter _, _, _ | _, M.Matter _, _ | _, _, M.Matter _ ->
invalid_arg "Modellib.Groves().vertices: lone matter field!"
| _, _, _ ->
[(inject 0 f1, inject 0 f2, inject 0 f3), v, c]
let clone4 ((f1, f2, f3, f4), v, c) =
match M.field f1, M.field f2, M.field f3, M.field f4 with
| M.Matter _, M.Matter _, M.Matter _, M.Matter _ ->
invalid_arg "Modellib.Groves().vertices: four matter fields!"
| M.Matter _, M.Matter _, M.Matter _, _
| M.Matter _, M.Matter _, _, M.Matter _
| M.Matter _, _, M.Matter _, M.Matter _
| _, M.Matter _, M.Matter _, M.Matter _ ->
invalid_arg "Modellib.Groves().vertices: three matter fields!"
| M.Matter f1', M.Matter f2', _, _ ->
List.map (fun g ->
((M (f1', g), M (f2', g), inject 0 f3, inject 0 f4), v, c))
generations
| M.Matter f1', _, M.Matter f3', _ ->
List.map (fun g ->
((M (f1', g), inject 0 f2, M (f3', g), inject 0 f4), v, c))
generations
| M.Matter f1', _, _, M.Matter f4' ->
List.map (fun g ->
((M (f1', g), inject 0 f2, inject 0 f3, M (f4', g)), v, c))
generations
| _, M.Matter f2', M.Matter f3', _ ->
List.map (fun g ->
((inject 0 f1, M (f2', g), M (f3', g), inject 0 f4), v, c))
generations
| _, M.Matter f2', _, M.Matter f4' ->
List.map (fun g ->
((inject 0 f1, M (f2', g), inject 0 f3, M (f4', g)), v, c))
generations
| _, _, M.Matter f3', M.Matter f4' ->
List.map (fun g ->
((inject 0 f1, inject 0 f2, M (f3', g), M (f4', g)), v, c))
generations
| M.Matter _, _, _, _ | _, M.Matter _, _, _
| _, _, M.Matter _, _ | _, _, _, M.Matter _ ->
invalid_arg "Modellib.Groves().vertices: lone matter field!"
| _, _, _, _ ->
[(inject 0 f1, inject 0 f2, inject 0 f3, inject 0 f4), v, c]
let clonen (fl, v, c) =
match List.map M.field fl with
| _ -> failwith "Modellib.Groves().vertices: incomplete"
let vertices () =
let vertices3, vertices4, verticesn = M.vertices () in
(ThoList.flatmap clone3 vertices3,
ThoList.flatmap clone4 vertices4,
ThoList.flatmap clonen verticesn)
let table = F.of_vertices (vertices ())
let fuse2 = F.fuse2 table
let fuse3 = F.fuse3 table
let fuse = F.fuse table
(* \begin{dubious}
The following (incomplete) alternative implementations are
included for illustrative purposes only:
\end{dubious} *)
let injectl g fcl =
List.map (fun (f, c) -> (inject g f, c)) fcl
let alt_fuse2 f1 f2 =
match f1, f2 with
| M (f1', g1'), M (f2', g2') ->
if g1' = g2' then
injectl 0 (M.fuse2 (M.matter_field f1') (M.matter_field f2'))
else
[]
| M (f1', g'), _ -> injectl g' (M.fuse2 (M.matter_field f1') (project f2))
| _, M (f2', g') -> injectl g' (M.fuse2 (project f1) (M.matter_field f2'))
| _, _ -> injectl 0 (M.fuse2 (project f1) (project f2))
let alt_fuse3 f1 f2 f3 =
match f1, f2, f3 with
| M (f1', g1'), M (f2', g2'), M (f3', g3') ->
invalid_arg "Modellib.Groves().fuse3: three matter fields!"
| M (f1', g1'), M (f2', g2'), _ ->
if g1' = g2' then
injectl 0
(M.fuse3 (M.matter_field f1') (M.matter_field f2') (project f3))
else
[]
| M (f1', g1'), _, M (f3', g3') ->
if g1' = g3' then
injectl 0
(M.fuse3 (M.matter_field f1') (project f2) (M.matter_field f3'))
else
[]
| _, M (f2', g2'), M (f3', g3') ->
if g2' = g3' then
injectl 0
(M.fuse3 (project f1) (M.matter_field f2') (M.matter_field f3'))
else
[]
| M (f1', g'), _, _ ->
injectl g' (M.fuse3 (M.matter_field f1') (project f2) (project f3))
| _, M (f2', g'), _ ->
injectl g' (M.fuse3 (project f1) (M.matter_field f2') (project f3))
| _, _, M (f3', g') ->
injectl g' (M.fuse3 (project f1) (project f2) (M.matter_field f3'))
| _, _, _ -> injectl 0 (M.fuse3 (project f1) (project f2) (project f3))
end
(* \thocwmodulesection{MSM With Cloned Families} *)
module SM_clones = Groves(SM(SM_no_anomalous))
module SM3_clones = Groves(SM3(SM_no_anomalous))
(*i
* Local Variables:
* mode:caml
* indent-tabs-mode:nil
* page-delimiter:"^(\\* .*\n"
* End:
i*)
Index: trunk/src/omega/src/modellib_PSSSM.ml
===================================================================
--- trunk/src/omega/src/modellib_PSSSM.ml (revision 2698)
+++ trunk/src/omega/src/modellib_PSSSM.ml (revision 2699)
@@ -1,1930 +1,1984 @@
(* $Id$
- Copyright (C) 1999-2009 by
+ Copyright (C) 1999-2010 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. *)
let rcs_file = RCS.parse "Modellib_PSSSM" ["Extended SUSY models"]
{ RCS.revision = "$Revision$";
RCS.date = "$Date$";
RCS.author = "$Author$";
RCS.source
= "$URL$" }
(* \thocwmodulesection{Extended Supersymmetric Standard Model(s)} *)
(* This is based on the NMSSM implementation by Felix Braam, and extended to
the exotica -- leptoquarks, leptoquarkinos, additional Higgses etc. -- by
Daniel Wiesler. Note that for the Higgs sector vertices the conventions of
the Franke/Fraas paper have been used. *)
module type extMSSM_flags =
sig
val ckm_present : bool
end
module PSSSM : extMSSM_flags =
struct
let ckm_present = false
end
module PSSSM_QCD : extMSSM_flags =
struct
let ckm_present = false
end
module ExtMSSM (Flags : extMSSM_flags) =
struct
let rcs = RCS.rename rcs_file "Modellib_PSSSM.NMSSM"
[ "Extended SUSY models" ]
open Coupling
let default_width = ref Timelike
let use_fudged_width = ref false
let options = Options.create
[ "constant_width", Arg.Unit (fun () -> default_width := Constant),
"use constant width (also in t-channel)";
"fudged_width", Arg.Set use_fudged_width,
"use fudge factor for charge particle width";
"custom_width", Arg.String (fun f -> default_width := Custom f),
"use custom width";
"cancel_widths", Arg.Unit (fun () -> default_width := Vanishing),
"use vanishing width"]
(*additional combinatorics *)
(* yields a list of tuples consistig of the off-diag combinations of the elements in "set" *)
let choose2 set =
List.map (function [x;y] -> (x,y) | _ -> failwith "choose2")
(Combinatorics.choose 2 set)
(* [pairs] *)
(* [pairs] appends the diagonal combinations to [choose2] *)
let rec diag = function
| [] -> []
| x1 :: rest -> (x1, x1) :: diag rest
let pairs l = choose2 l @ diag l
(* [triples] *)
(* rank 3 generalization of [pairs] *)
let rec cloop set i j k =
if i > ((List.length set)-1) then []
else if j > i then cloop set (succ i) (j-i-1) (j-i-1)
else if k > j then cloop set i (succ j) (k-j-1)
else (List.nth set i, List.nth set j, List.nth set k) :: cloop set i j (succ k)
let triples set = cloop set 0 0 0
(* [two_and_one] *)
let rec two_and_one' l1 z n =
if n < 0 then []
else
((fst (List.nth (pairs l1) n)),(snd (List.nth (pairs l1) n)), z):: two_and_one' l1 z (pred n)
let two_and_one l1 l2 =
let f z = two_and_one' l1 z ((List.length (pairs l1))-1)
in
List.flatten ( List.map f l2 )
type gen =
| G of int | GG of gen*gen
let rec string_of_gen = function
| G n when n > 0 -> string_of_int n
| G n -> string_of_int (abs n) ^ "c"
| GG (g1,g2) -> string_of_gen g1 ^ "_" ^ string_of_gen g2
(* With this we distinguish the flavour. *)
type sff =
| SL | SN | SU | SD
let string_of_sff = function
| SL -> "sl" | SN -> "sn" | SU -> "su" | SD -> "sd"
(* With this we distinguish the mass eigenstates. At the moment we have to cheat
a little bit for the sneutrinos. Because we are dealing with massless
neutrinos there is only one sort of sneutrino. *)
type sfm =
| M1 | M2
let string_of_sfm = function
| M1 -> "1" | M2 -> "2"
(* We also introduce special types for the charginos and neutralinos. *)
type char =
| C1 | C2 | C1c | C2c | C3 | C3c | C4 | C4c
type neu =
| N1 | N2 | N3 | N4 | N5 | N6 | N7 | N8 | N9 | N10 | N11
let int_of_char = function
| C1 -> 1 | C2 -> 2 | C1c -> -1 | C2c -> -2
| C3 -> 3 | C4 -> 4 | C3c -> -3 | C4c -> -4
let string_of_char c = string_of_int (int_of_char c)
let conj_char = function
| C1 -> C1c | C2 -> C2c | C1c -> C1 | C2c -> C2
| C3 -> C3c | C4 -> C4c | C3c -> C3 | C4c -> C4
let string_of_neu = function
| N1 -> "1" | N2 -> "2" | N3 -> "3" | N4 -> "4" | N5 -> "5" | N6 -> "6"
| N7 -> "7" | N8 -> "8" | N9 -> "9" | N10 -> "10"| N11 -> "11"
(* For NMSSM-like the Higgs bosons, we follow the conventions of
Franke/Fraas. Daniel Wiesler: extended to E6 models. *)
type shiggs =
| S1 | S2 | S3 | S4 | S5 | S6 | S7 | S8 | S9
type phiggs =
| P1 | P2 | P3 | P4 | P5 | P6 | P7
(* [HCx] is always the $H^+$, [HCxc] the $H^-$. *)
type chiggs =
| HC1 | HC2 | HC3 | HC4 | HC5 | HC1c | HC2c | HC3c | HC4c | HC5c
let conj_chiggs = function
| HC1 -> HC1c | HC2 -> HC2c | HC1c -> HC1 | HC2c -> HC2
| HC3 -> HC3c | HC4 -> HC4c | HC3c -> HC3 | HC4c -> HC4
| HC5 -> HC5c | HC5c -> HC5
let string_of_shiggs = function
| S1 -> "1" | S2 -> "2" | S3 -> "3" | S4 -> "4" | S5 -> "5"
| S6 -> "6" | S7 -> "7" | S8 -> "8" | S9 -> "9"
let string_of_phiggs = function
| P1 -> "1" | P2 -> "2" | P3 -> "3" | P4 -> "4" | P5 -> "5"
| P6 -> "6" | P7 -> "7"
let nlist = [ N1; N2; N3; N4; N5; N6; N7; N8; N9; N10; N11 ]
let slist = [ S1; S2; S3; S4; S5; S6; S7; S8; S9 ]
let plist = [ P1; P2; P3; P4; P5; P6; P7 ]
let clist = [ HC1; HC2; HC3; HC4; HC5; HC1c; HC2c; HC3c; HC4c; HC5c ]
let charlist = [ C1; C2; C3; C4; C1c; C2c; C3c; C4c ]
type flavor =
| L of int | N of int
| U of int | D of int
| Sup of sfm*int | Sdown of sfm*int
| Ga | Wp | Wm | Z | Gl
| Slepton of sfm*int | Sneutrino of int
| Neutralino of neu | Chargino of char
| Gluino | SHiggs of shiggs | PHiggs of phiggs
| CHiggs of chiggs
| LQ of sfm*int
| LQino of int
let string_of_fermion_type = function
| L _ -> "l" | U _ -> "u" | D _ -> "d" | N _ -> "n"
| _ -> failwith
"Modellib_PSSSM.ExtMSSM.string_of_fermion_type: invalid fermion type"
let string_of_fermion_gen = function
| L g | U g | D g | N g -> string_of_int (abs (g))
| _ -> failwith
"Modellib_PSSSM.ExtMSSM.string_of_fermion_gen: invalid fermion type"
type gauge = unit
let gauge_symbol () =
failwith "Modellib_PSSSM.ExtMSSM.gauge_symbol: internal error"
(* At this point we will forget graviton and -ino. *)
let family g = [ L g; N g; Slepton (M1,g);
Slepton (M2,g); Sneutrino g;
U g; D g; Sup (M1,g); Sup (M2,g);
Sdown (M1,g); Sdown (M2,g);
LQ (M1,g); LQ (M2,g); LQino g ]
let external_flavors () =
[ "1st Generation matter", ThoList.flatmap family [1; -1];
"2nd Generation matter", ThoList.flatmap family [2; -2];
"3rd Generation matter", ThoList.flatmap family [3; -3];
"Gauge Bosons", [Ga; Z; Wp; Wm; Gl];
"Charginos", List.map (fun a -> Chargino a) charlist;
"Neutralinos", List.map (fun a -> Neutralino a) nlist;
"Higgs Bosons", List.map (fun a -> SHiggs a) slist @
List.map (fun a -> PHiggs a) plist @
List.map (fun a -> CHiggs a) clist;
"Gluino", [Gluino]]
let flavors () = ThoList.flatmap snd (external_flavors ())
let spinor n m =
if n >= 0 && m >= 0 then
Spinor
else if
n <= 0 && m <=0 then
ConjSpinor
else
invalid_arg "Modellib_PSSSM.ExtMSSM.spinor: internal error"
let lorentz = function
| L g -> spinor g 0 | N g -> spinor g 0
| U g -> spinor g 0 | D g -> spinor g 0
| LQino g -> spinor g 0
| Chargino c -> spinor (int_of_char c) 0
| Ga | Gl -> Vector
| Wp | Wm | Z -> Massive_Vector
| SHiggs _ | PHiggs _ | CHiggs _
| Sup _ | Sdown _ | Slepton _ | Sneutrino _ | LQ _ -> Scalar
| Neutralino _ | Gluino -> Majorana
let color = function
| U g -> Color.SUN (if g > 0 then 3 else -3)
| Sup (m,g) -> Color.SUN (if g > 0 then 3 else -3)
| D g -> Color.SUN (if g > 0 then 3 else -3)
| Sdown (m,g) -> Color.SUN (if g > 0 then 3 else -3)
| LQ (m,g) -> Color.SUN (if g > 0 then 3 else -3)
| LQino g -> Color.SUN (if g > 0 then 3 else -3)
| Gl | Gluino -> Color.AdjSUN 3
| _ -> Color.Singlet
let prop_spinor n m =
if n >= 0 && m >=0 then
Prop_Spinor
else if
n <=0 && m <=0 then
Prop_ConjSpinor
else
invalid_arg "Modellib_PSSSM.ExtMSSM.prop_spinor: internal error"
let propagator = function
| L g -> prop_spinor g 0 | N g -> prop_spinor g 0
| U g -> prop_spinor g 0 | D g -> prop_spinor g 0
| LQino g -> prop_spinor g 0
| Chargino c -> prop_spinor (int_of_char c) 0
| Ga | Gl -> Prop_Feynman
| Wp | Wm | Z -> Prop_Unitarity
| SHiggs _ | PHiggs _ | CHiggs _ -> Prop_Scalar
| Sup _ | Sdown _ | Slepton _ | Sneutrino _ -> Prop_Scalar
| LQ _ -> Prop_Scalar
| Gluino -> Prop_Majorana
| Neutralino _ -> Prop_Majorana
(* Optionally, ask for the fudge factor treatment for the widths of
charged particles. Currently, this only applies to $W^\pm$ and top. *)
let width f =
if !use_fudged_width then
match f with
| Wp | Wm | U 3 | U (-3) -> Fudged
| _ -> !default_width
else
!default_width
let goldstone _ = None
let conjugate = function
| L g -> L (-g) | N g -> N (-g)
| U g -> U (-g) | D g -> D (-g)
| Sup (m,g) -> Sup (m,-g)
| Sdown (m,g) -> Sdown (m,-g)
| Slepton (m,g) -> Slepton (m,-g)
| Sneutrino g -> Sneutrino (-g)
| Gl -> Gl | Ga -> Ga | Z -> Z
| Wp -> Wm | Wm -> Wp
| SHiggs s -> SHiggs s
| PHiggs p -> PHiggs p
| CHiggs c -> CHiggs (conj_chiggs c)
| Gluino -> Gluino
| Neutralino n -> Neutralino n | Chargino c -> Chargino (conj_char c)
| LQino g -> LQino (-g)
| LQ (m,g) -> LQ (m,-g)
let fermion = function
| L g -> if g > 0 then 1 else -1
| N g -> if g > 0 then 1 else -1
| U g -> if g > 0 then 1 else -1
| D g -> if g > 0 then 1 else -1
| Gl | Ga | Z | Wp | Wm -> 0
| SHiggs _ | PHiggs _ | CHiggs _ -> 0
| Neutralino _ -> 2
| Chargino c -> if (int_of_char c) > 0 then 1 else -1
| Sup _ -> 0 | Sdown _ -> 0
| Slepton _ -> 0 | Sneutrino _ -> 0
| Gluino -> 2
| LQ _ -> 0
| LQino g -> if g > 0 then 1 else -1
- module Ch = Charges.Null
- let charges _ = ()
+ module Ch = Charges.QQ
+
+ let ( // ) = Algebra.Small_Rational.make
+
+ let generation' = function
+ | 1 -> [ 1//1; 0//1; 0//1]
+ | 2 -> [ 0//1; 1//1; 0//1]
+ | 3 -> [ 0//1; 0//1; 1//1]
+ | -1 -> [-1//1; 0//1; 0//1]
+ | -2 -> [ 0//1; -1//1; 0//1]
+ | -3 -> [ 0//1; 0//1; -1//1]
+ | n -> invalid_arg ("NMSSM.generation': " ^ string_of_int n)
+
+ let generation f =
+ if Flags.ckm_present then
+ []
+ else
+ match f with
+ | L n | N n | U n | D n | Sup (_,n)
+ | Sdown (_,n) | Slepton (_,n)
+ | Sneutrino n -> generation' n
+ | _ -> [0//1; 0//1; 0//1]
+
+ let charge = function
+ | L n -> if n > 0 then -1//1 else 1//1
+ | Slepton (_,n) -> if n > 0 then -1//1 else 1//1
+ | N n -> 0//1
+ | Sneutrino n -> 0//1
+ | U n -> if n > 0 then 2//3 else -2//3
+ | Sup (_,n) -> if n > 0 then 2//3 else -2//3
+ | D n | LQ (_,n) | LQino n -> if n > 0 then -1//3 else 1//3
+ | Sdown (_,n) -> if n > 0 then -1//3 else 1//3
+ | Gl | Ga | Z | Neutralino _ | Gluino -> 0//1
+ | Wp -> 1//1
+ | Wm -> -1//1
+ | SHiggs _ | PHiggs _ -> 0//1
+ | CHiggs (HC1|HC2|HC3|HC4|HC5) -> 1//1
+ | CHiggs (HC1c|HC2c|HC3c|HC4c|HC5c) -> -1//1
+ | Chargino (C1|C2|C3|C4) -> 1//1
+ | Chargino (C1c|C2c|C3c|C4c) -> -1//1
+
+ let lepton = function
+ | L n | N n -> if n > 0 then 1//1 else -1//1
+ | Slepton (_,n)
+ | Sneutrino n -> if n > 0 then 1//1 else -1//1
+ | LQ (_,n) | LQino n -> if n > 0 then 1//1 else -1//1
+ | _ -> 0//1
+
+ let baryon = function
+ | U n | D n -> if n > 0 then 1//1 else -1//1
+ | Sup (_,n) | Sdown (_,n) -> if n > 0 then 1//1 else -1//1
+ | LQ (_,n) | LQino n -> if n > 0 then 1//1 else -1//1
+ | _ -> 0//1
+
+ let charges f =
+ [ charge f; lepton f; baryon f] @ generation f
(* We introduce a Boolean type vc as a pseudonym for Vertex Conjugator to
distinguish between vertices containing complex mixing matrices like the
CKM--matrix or the sfermion or neutralino/chargino--mixing matrices, which
have to become complex conjugated. The true--option stands for the conjugated
vertex, the false--option for the unconjugated vertex. *)
type vc = bool
type constant =
| E | G
| Q_lepton | Q_up | Q_down | Q_charg
| G_Z | G_CC | G_CCQ of vc*int*int
| G_NC_neutrino | G_NC_lepton | G_NC_up | G_NC_down
| I_Q_W | I_G_ZWW | G_WWWW | G_ZZWW | G_PZWW | G_PPWW
| G_strong | G_SS | I_G_S
| Gs
| G_NZN of neu*neu | G_CZC of char*char
| G_YUK_FFS of flavor*flavor*shiggs
| G_YUK_FFP of flavor*flavor*phiggs
| G_YUK_LCN of int
| G_YUK_UCD of int*int | G_YUK_DCU of int*int
| G_NHC of vc*neu*char
| G_YUK_C of vc*flavor*char*sff*sfm
| G_YUK_Q of vc*int*flavor*char*sff*sfm
| G_YUK_N of vc*flavor*neu*sff*sfm
| G_YUK_G of vc*flavor*sff*sfm
| G_NWC of neu*char | G_CWN of char*neu
| G_CSC of char*char*shiggs
| G_CPC of char*char*phiggs
| G_WSQ of vc*int*int*sfm*sfm
| G_SLSNW of vc*int*sfm
| G_ZSF of sff*int*sfm*sfm
| G_CICIS of neu*neu*shiggs
| G_CICIP of neu*neu*phiggs
| G_GH_WPC of phiggs | G_GH_WSC of shiggs
| G_GH_ZSP of shiggs*phiggs | G_GH_WWS of shiggs
| G_GH_ZZS of shiggs | G_GH_ZCC
| G_GH_GaCC
| G_GH4_ZZPP of phiggs*phiggs
| G_GH4_ZZSS of shiggs*shiggs
| G_GH4_ZZCC | G_GH4_GaGaCC
| G_GH4_ZGaCC | G_GH4_WWCC
| G_GH4_WWPP of phiggs*phiggs
| G_GH4_WWSS of shiggs*shiggs
| G_GH4_ZWSC of shiggs
| G_GH4_GaWSC of shiggs
| G_GH4_ZWPC of phiggs
| G_GH4_GaWPC of phiggs
| G_WWSFSF of sff*int*sfm*sfm
| G_WPSLSN of vc*int*sfm
| G_H3_SCC of shiggs
| G_H3_SSS of shiggs*shiggs*shiggs
| G_H3_SPP of shiggs*phiggs*phiggs
| G_SFSFS of shiggs*sff*int*sfm*sfm
| G_SFSFP of phiggs*sff*int*sfm*sfm
| G_HSNSL of vc*int*sfm
| G_HSUSD of vc*sfm*sfm*int*int
| G_WPSUSD of vc*sfm*sfm*int*int
| G_WZSUSD of vc*sfm*sfm*int*int
| G_WZSLSN of vc*int*sfm | G_GlGlSQSQ
| G_PPSFSF of sff
| G_ZZSFSF of sff*int*sfm*sfm | G_ZPSFSF of sff*int*sfm*sfm
| G_GlZSFSF of sff*int*sfm*sfm | G_GlPSQSQ
| G_GlWSUSD of vc*sfm*sfm*int*int
| G_YUK_LQ_S of int*shiggs*int
| G_YUK_LQ_P of int*phiggs*int
| G_LQ_NEU of sfm*int*int*neu
| G_LQ_EC_UC of vc*sfm*int*int*int
| G_LQ_GG of sfm*int*int
| G_LQ_SSU of sfm*sfm*sfm*int*int*int
| G_LQ_SSD of sfm*sfm*int*int*int
| G_LQ_S of sfm*sfm*int*shiggs*int
| G_LQ_P of sfm*sfm*int*phiggs*int
| G_ZLQ of int*sfm*sfm
| G_ZZLQLQ | G_ZPLQLQ | G_PPLQLQ | G_ZGlLQLQ | G_PGlLQLQ | G_NLQC | G_GlGlLQLQ
(* \begin{subequations}
\begin{align}
\alpha_{\text{QED}} &= \frac{1}{137.0359895} \\
\sin^2\theta_w &= 0.23124
\end{align}
\end{subequations}
Here we must perhaps allow for complex input parameters. So split them
into their modulus and their phase. At first, we leave them real; the
generalization to complex parameters is obvious. *)
let parameters () =
{ input = [];
derived = [];
derived_arrays = [] }
module F = Modeltools.Fusions (struct
type f = flavor
type c = constant
let compare = compare
let conjugate = conjugate
end)
(* For the couplings there are generally two possibilities concerning the
sign of the covariant derivative.
\begin{equation}
{\rm CD}^\pm = \partial_\mu \pm \ii g T^a A^a_\mu
\end{equation}
The particle data group defines the signs consistently to be positive.
Since the convention for that signs also influence the phase definitions
of the gaugino/higgsino fields via the off-diagonal entries in their
mass matrices it would be the best to adopt that convention. *)
(*** REVISED: Compatible with CD+. FB ***)
let electromagnetic_currents_3 g =
[ ((L (-g), Ga, L g), FBF (1, Psibar, V, Psi), Q_lepton);
((U (-g), Ga, U g), FBF (1, Psibar, V, Psi), Q_up);
((D (-g), Ga, D g), FBF (1, Psibar, V, Psi), Q_down)]
(*** REVISED: Compatible with CD+. FB***)
let electromagnetic_sfermion_currents g m =
[ ((Ga, Slepton (m,-g), Slepton (m,g)), Vector_Scalar_Scalar 1, Q_lepton);
((Ga, Sup (m,-g), Sup (m,g)), Vector_Scalar_Scalar 1, Q_up);
((Ga, Sdown (m,-g), Sdown (m,g)), Vector_Scalar_Scalar 1, Q_down)]
(*** REVISED: Compatible with CD+. FB***)
let electromagnetic_currents_2 c =
let cc = conj_char c in
[ ((Chargino cc, Ga, Chargino c), FBF (1, Psibar, V, Psi), Q_charg) ]
(*** REVISED: Compatible with CD+. FB***)
let neutral_currents g =
[ ((L (-g), Z, L g), FBF (1, Psibar, VA, Psi), G_NC_lepton);
((N (-g), Z, N g), FBF (1, Psibar, VA, Psi), G_NC_neutrino);
((U (-g), Z, U g), FBF (1, Psibar, VA, Psi), G_NC_up);
((D (-g), Z, D g), FBF (1, Psibar, VA, Psi), G_NC_down)]
(* \begin{equation}
\mathcal{L}_{\textrm{CC}} =
\mp \frac{g}{2\sqrt2} \sum_i \bar\psi_i \gamma^\mu
(1-\gamma_5)(T^+W^+_\mu+T^-W^-_\mu)\psi_i ,
\end{equation}
where the sign corresponds to $\text{CD}_\pm$, respectively. *)
(*** REVISED: Compatible with CD+. ***)
(* Remark: The definition with the other sign compared to the SM files
comes from the fact that $g_{cc} = 1/(2\sqrt{2})$ is used
overwhelmingly often in the SUSY Feynman rules, so that JR
decided to use a different definiton for [g_cc] in SM and MSSM. *)
(** FB **)
let charged_currents g =
[ ((L (-g), Wm, N g), FBF ((-1), Psibar, VL, Psi), G_CC);
((N (-g), Wp, L g), FBF ((-1), Psibar, VL, Psi), G_CC) ]
(* The quark with the inverted generation (the antiparticle) is the outgoing
one, the other the incoming. The vertex attached to the outgoing up-quark
contains the CKM matrix element {\em not} complex conjugated, while the
vertex with the outgoing down-quark has the conjugated CKM matrix
element. *)
(*** REVISED: Compatible with CD+. FB ***)
let charged_quark_currents g h =
[ ((D (-g), Wm, U h), FBF ((-1), Psibar, VL, Psi), G_CCQ (true,g,h));
((U (-g), Wp, D h), FBF ((-1), Psibar, VL, Psi), G_CCQ (false,h,g))]
(*** REVISED: Compatible with CD+.FB ***)
let charged_chargino_currents n c =
let cc = conj_char c in
[ ((Chargino cc, Wp, Neutralino n),
FBF (1, Psibar, VLR, Chi), G_CWN (c,n));
((Neutralino n, Wm, Chargino c),
FBF (1, Chibar, VLR, Psi), G_NWC (n,c)) ]
(*** REVISED: Compatible with CD+. FB***)
let charged_slepton_currents g m =
[ ((Wm, Slepton (m,-g), Sneutrino g), Vector_Scalar_Scalar (-1), G_SLSNW
(true,g,m));
((Wp, Slepton (m,g), Sneutrino (-g)), Vector_Scalar_Scalar 1, G_SLSNW
(false,g,m)) ]
(*** REVISED: Compatible with CD+. FB***)
let charged_squark_currents' g h m1 m2 =
[ ((Wm, Sup (m1,g), Sdown (m2,-h)), Vector_Scalar_Scalar (-1), G_WSQ
(true,g,h,m1,m2));
((Wp, Sup (m1,-g), Sdown (m2,h)), Vector_Scalar_Scalar 1, G_WSQ
(false,g,h,m1,m2)) ]
let charged_squark_currents g h =
List.flatten (Product.list2 (charged_squark_currents' g h) [M1;M2] [M1;M2] )
(*** REVISED: Compatible with CD+. FB ***)
let neutral_sfermion_currents' g m1 m2 =
[ ((Z, Slepton (m1,-g), Slepton (m2,g)), Vector_Scalar_Scalar (-1),
G_ZSF (SL,g,m1,m2));
((Z, Sup (m1,-g), Sup (m2,g)), Vector_Scalar_Scalar (-1),
G_ZSF (SU,g,m1,m2));
((Z, Sdown (m1,-g), Sdown (m2,g)), Vector_Scalar_Scalar (-1),
G_ZSF (SD,g,m1,m2))]
let neutral_sfermion_currents g =
List.flatten (Product.list2 (neutral_sfermion_currents'
g) [M1;M2] [M1;M2]) @
[ ((Z, Sneutrino (-g), Sneutrino g), Vector_Scalar_Scalar (-1),
G_ZSF (SN,g,M1,M1)) ]
(* The reality of the coupling of the Z-boson to two identical neutralinos
makes the vector part of the coupling vanish. So we distinguish them not
by the name but by the structure of the couplings. *)
(*** REVISED: Compatible with CD+. FB***)
let neutral_Z (n,m) =
[ ((Neutralino n, Z, Neutralino m), FBF (1, Chibar, VA, Chi),
(G_NZN (n,m))) ]
(*** REVISED: Compatible with CD+. FB***)
let charged_Z c1 c2 =
let cc1 = conj_char c1 in
((Chargino cc1, Z, Chargino c2), FBF ((-1), Psibar, VA , Psi),
G_CZC (c1,c2))
(*** REVISED: Compatible with CD+.
Remark: This is pure octet. FB***)
let yukawa_v =
[ (Gluino, Gl, Gluino), FBF (1, Chibar, V, Chi), Gs]
(*** REVISED: Independent of the sign of CD. ***)
(*** REVISED: Felix Braam: Compact version using new COMBOS + FF-Couplings *)
let yukawa_higgs_FFS f s =
[((conjugate f, SHiggs s, f ), FBF (1, Psibar, S, Psi),
G_YUK_FFS (conjugate f, f, s))]
let yukawa_higgs_FFP f p =
[((conjugate f, PHiggs p, f), FBF (1, Psibar, P, Psi),
G_YUK_FFP (conjugate f ,f , p))]
(* JR: Only the first charged Higgs. *)
let yukawa_higgs_NLC g =
[ ((N (-g), CHiggs HC1, L g), FBF (1, Psibar, Coupling.SR, Psi),
G_YUK_LCN g);
((L (-g), CHiggs HC1c, N g), FBF (1, Psibar, Coupling.SL, Psi),
G_YUK_LCN g)]
let yukawa_higgs g =
yukawa_higgs_NLC g @
List.flatten ( Product.list2 yukawa_higgs_FFS [L g; U g; D g] [S1; S2; S3]) @
List.flatten ( Product.list2 yukawa_higgs_FFP [L g; U g; D g] [P1; P2])
(* JR: Only the first charged Higgs. *)
(*** REVISED: Independent of the sign of CD. FB***)
let yukawa_higgs_quark (g,h) =
[ ((U (-g), CHiggs HC1, D h), FBF (1, Psibar, SLR, Psi),
G_YUK_UCD (g, h));
((D (-h), CHiggs HC1c, U g), FBF (1, Psibar, SLR, Psi),
G_YUK_DCU (g, h)) ]
(*** REVISED: Compatible with CD+.FB*)
(*** REVISED: Compact version using new COMBOS*)
let yukawa_shiggs_2 c1 c2 s =
let cc1 = conj_char c1 in
((Chargino cc1, SHiggs s, Chargino c2), FBF (1, Psibar, SLR, Psi),
G_CSC (c1,c2,s))
let yukawa_phiggs_2 c1 c2 p =
let cc1 = conj_char c1 in
((Chargino cc1, PHiggs p, Chargino c2), FBF (1, Psibar, SLR, Psi),
G_CPC (c1,c2,p))
let yukawa_higgs_2 =
Product.list3 yukawa_shiggs_2 [C1;C2] [C1;C2] [S1;S2;S3] @
Product.list3 yukawa_phiggs_2 [C1;C2] [C1;C2] [P1;P2]
(* JR: Only the first charged Higgs. *)
(*** REVISED: Compatible with CD+.FB ***)
let higgs_charg_neutr n c =
let cc = conj_char c in
[ ((Neutralino n, CHiggs HC1c, Chargino c), FBF (-1, Chibar, SLR, Psi),
G_NHC (false,n,c));
((Chargino cc, CHiggs HC1, Neutralino n), FBF (-1, Psibar, SLR, Chi),
G_NHC (true,n,c)) ]
(*** REVISED: Compatible with CD+. FB***)
(*** REVISED: Compact version using new COMBOS*)
let shiggs_neutr (n,m,s) =
((Neutralino n, SHiggs s, Neutralino m), FBF (1, Chibar, SP, Chi),
G_CICIS (n,m,s))
let phiggs_neutr (n,m,p) =
((Neutralino n, PHiggs p, Neutralino m), FBF (1, Chibar, SP, Chi),
G_CICIP (n,m,p))
let higgs_neutr =
List.map shiggs_neutr (two_and_one [N1;N2;N3;N4;N5] [S1;S2;S3]) @
List.map phiggs_neutr (two_and_one [N1;N2;N3;N4;N5] [P1;P2])
(*** REVISED: Compatible with CD+. FB***)
let yukawa_n_2 n m g =
[ ((Neutralino n, Slepton (m,-g), L g), FBF (1, Chibar, SLR, Psi),
G_YUK_N (true,L g,n,SL,m));
((L (-g), Slepton (m,g), Neutralino n), FBF (1, Psibar, SLR, Chi),
G_YUK_N (false,L g,n,SL,m));
((Neutralino n, Sup (m,-g), U g), FBF (1, Chibar, SLR, Psi),
G_YUK_N (true,U g,n,SU,m));
((U (-g), Sup (m,g), Neutralino n), FBF (1, Psibar, SLR, Chi),
G_YUK_N (false,U g,n,SU,m));
((Neutralino n, Sdown (m,-g), D g), FBF (1, Chibar, SLR, Psi),
G_YUK_N (true,D g,n,SD,m));
((D (-g), Sdown (m,g), Neutralino n), FBF (1, Psibar, SLR, Chi),
G_YUK_N (false,D g,n,SD,m)) ]
let yukawa_n_3 n g =
[ ((Neutralino n, Sneutrino (-g), N g), FBF (1, Chibar, SLR, Psi),
G_YUK_N (true,N g,n,SN,M1));
((N (-g), Sneutrino g, Neutralino n), FBF (1, Psibar, SLR, Chi),
G_YUK_N (false,N g, n,SN,M1)) ]
let yukawa_n_5 g m =
[ ((U (-g), Sup (m,g), Gluino), FBF (1, Psibar, SLR, Chi),
G_YUK_G (false,U g,SU,m));
((D (-g), Sdown (m,g), Gluino), FBF (1, Psibar, SLR, Chi),
G_YUK_G (false,D g,SD,m));
((Gluino, Sup (m,-g), U g), FBF (1, Chibar, SLR, Psi),
G_YUK_G (true,U g,SU,m));
((Gluino, Sdown (m,-g), D g), FBF (1, Chibar, SLR, Psi),
G_YUK_G (true,D g,SD,m))]
let yukawa_n =
List.flatten (Product.list3 yukawa_n_2 [N1;N2;N3;N4;N5] [M1;M2] [1;2;3]) @
List.flatten (Product.list2 yukawa_n_3 [N1;N2;N3;N4;N5] [1;2;3]) @
List.flatten (Product.list2 yukawa_n_5 [1;2;3] [M1;M2])
(*** REVISED: Compatible with CD+.FB ***)
let yukawa_c_2 c g =
let cc = conj_char c in
[ ((L (-g), Sneutrino g, Chargino cc), BBB (1, Psibar, SLR,
Psibar), G_YUK_C (true,L g,c,SN,M1));
((Chargino c, Sneutrino (-g), L g), PBP (1, Psi, SLR, Psi),
G_YUK_C (false,L g,c,SN,M1)) ]
let yukawa_c_3 c m g =
let cc = conj_char c in
[ ((N (-g), Slepton (m,g), Chargino c), FBF (1, Psibar, SLR,
Psi), G_YUK_C (true,N g,c,SL,m));
((Chargino cc, Slepton (m,-g), N g), FBF (1, Psibar, SLR,
Psi), G_YUK_C (false,N g,c,SL,m)) ]
let yukawa_c c =
ThoList.flatmap (yukawa_c_2 c) [1;2;3] @
List.flatten (Product.list2 (yukawa_c_3 c) [M1;M2] [1;2;3])
(*** REVISED: Compatible with CD+. FB***)
let yukawa_cq' c (g,h) m =
let cc = conj_char c in
[ ((Chargino c, Sup (m,-g), D h), PBP (1, Psi, SLR, Psi),
G_YUK_Q (false,g,D h,c,SU,m));
((D (-h), Sup (m,g), Chargino cc), BBB (1, Psibar, SLR, Psibar),
G_YUK_Q (true,g,D h,c,SU,m));
((Chargino cc, Sdown (m,-g), U h), FBF (1, Psibar, SLR, Psi),
G_YUK_Q (true,g,U h,c,SD,m));
((U (-h), Sdown (m,g), Chargino c), FBF (1, Psibar, SLR, Psi),
G_YUK_Q (false,g,U h,c,SD,m)) ]
let yukawa_cq c =
if Flags.ckm_present then
List.flatten (Product.list2 (yukawa_cq' c) [(1,1);(1,2);(2,1);(2,2);(1,3);(2,3);(3,3);(3,2);(3,1)] [M1;M2])
else
List.flatten (Product.list2 (yukawa_cq' c) [(1,1);(2,2);(3,3)] [M1;M2])
(*** REVISED: Compatible with CD+.
Remark: Singlet and octet gluon exchange. The coupling is divided by
sqrt(2) to account for the correct normalization of the Lie algebra
generators.
**FB*)
let col_currents g =
[ ((D (-g), Gl, D g), FBF ((-1), Psibar, V, Psi), Gs);
((U (-g), Gl, U g), FBF ((-1), Psibar, V, Psi), Gs)]
(*** REVISED: Compatible with CD+.
Remark: Singlet and octet gluon exchange. The coupling is divided by
sqrt(2) to account for the correct normalization of the Lie algebra
generators.
**FB*)
(** LQ-coupl. **DW**)
let chg = function
| M1 -> M2 | M2 -> M1
(** LQ - Yuk's **)
let yuk_lqino_se_uc1' g1 g2 g3 m =
let cm = chg m in
[ ((U (-g3), Slepton (m,-g2), LQino g1), FBF (1, Psibar, SLR, Psi),
G_LQ_EC_UC (true,cm,g1,g2,g3)) ]
let yuk_lqino_se_uc1 g1 g2 g3 =
ThoList.flatmap (yuk_lqino_se_uc1' g1 g2 g3) [M1;M2]
let yuk_lqino_se_uc2' g1 g2 g3 m =
let cm = chg m in
[ ((LQino (-g1), Slepton (m,g2), U g3), FBF (1, Psibar, SLR, Psi),
G_LQ_EC_UC (false,cm,g1,g2,g3)) ]
let yuk_lqino_se_uc2 g1 g2 g3 =
ThoList.flatmap (yuk_lqino_se_uc2' g1 g2 g3) [M1;M2]
let yuk_lqino_sn_dc1 g1 g2 g3 =
[ ((D (-g3), Sneutrino (-g2), LQino g1), FBF (-1, Psibar, SLR, Psi),
G_LQ_EC_UC (true,M2,g1,g2,g3)) ]
let yuk_lqino_sn_dc2 g1 g2 g3 =
[ ((LQino (-g1), Sneutrino g2, D g3), FBF (-1, Psibar, SLR, Psi),
G_LQ_EC_UC (false,M2,g1,g2,g3)) ]
let yuk_lqino_ec_su1' g1 g2 g3 m =
let cm = chg m in
[ ((LQino (-g1), Sup (m,g3), L g2), FBF (1, Psibar, SLR, Psi),
G_LQ_EC_UC (true,cm,g1,g2,g3)) ]
let yuk_lqino_ec_su1 g1 g2 g3 =
ThoList.flatmap (yuk_lqino_ec_su1' g1 g2 g3) [M1;M2]
let yuk_lqino_ec_su2' g1 g2 g3 m =
let cm = chg m in
[ ((L (-g2), Sup (m,-g3), LQino (g1)), FBF (1, Psibar, SLR, Psi),
G_LQ_EC_UC (false,cm,g1,g2,g3)) ]
let yuk_lqino_ec_su2 g1 g2 g3 =
ThoList.flatmap (yuk_lqino_ec_su2' g1 g2 g3) [M1;M2]
let yuk_lqino_nc_sd1 g1 g2 g3 =
[ ((LQino (-g1), Sdown (M1,g3), N g2), FBF (-1, Psibar, SLR, Psi),
G_LQ_EC_UC (true,M2,g1,g2,g3)) ]
let yuk_lqino_nc_sd2 g1 g2 g3 =
[ ((N (-g2), Sdown (M1,-g3), LQino (g1)), FBF (-1, Psibar, SLR, Psi),
G_LQ_EC_UC (false,M2,g1,g2,g3)) ]
let yuk_lq_ec_uc' g1 g2 g3 m =
[ ((L (-g2), LQ (m,g1), U (-g3)), BBB (1, Psibar, SLR, Psibar),
G_LQ_EC_UC (false,m,g1,g2,g3)) ]
let yuk_lq_ec_uc g1 g2 g3 =
ThoList.flatmap (yuk_lq_ec_uc' g1 g2 g3) [M1;M2]
let yuk_lq_ec_uc2' g1 g2 g3 m =
[ ((L (g2), LQ (m,-g1), U (g3)), PBP (1, Psi, SLR, Psi),
G_LQ_EC_UC (true,m,g1,g2,g3)) ]
let yuk_lq_ec_uc2 g1 g2 g3 =
ThoList.flatmap (yuk_lq_ec_uc2' g1 g2 g3) [M1;M2]
let yuk_lq_nc_dc g1 g2 g3 =
[ ((N (-g2), LQ (M2,g1), D (-g3)), BBB (-1, Psibar, SLR, Psibar),
G_LQ_EC_UC (false,M2,g1,g2,g3)) ]
let yuk_lq_nc_dc2 g1 g2 g3 =
[ ((N (g2), LQ (M2,-g1), D (g3)), PBP (-1, Psi, SLR, Psi),
G_LQ_EC_UC (true,M2,g1,g2,g3)) ]
(*** Daniel Wiesler: LQ - F-Term w/ vev ***)
let lq_se_su' g1 g2 g3 m1 m2 m3 =
[ ((LQ (m1,g1), Slepton (m2,-g2), Sup (m3,-g3)), Scalar_Scalar_Scalar 1,
G_LQ_SSU (m1,m2,m3,g1,g2,g3)) ]
let lq_se_su g1 g2 g3 =
List.flatten (Product.list3 (lq_se_su' g1 g2 g3) [M1;M2] [M1;M2] [M1;M2] )
let lq_snu_sd' g1 g2 g3 m1 m2 =
[ ((LQ (m1,g1), Sdown (m2,-g2), Sneutrino (-g3)), Scalar_Scalar_Scalar 1,
G_LQ_SSD (m1,m2,g1,g2,g3)) ]
let lq_snu_sd g1 g2 g3 =
List.flatten (Product.list2 (lq_snu_sd' g1 g2 g3) [M1;M2] [M1;M2] )
(*** Daniel Wiesler: LQ - Higgs ***)
let lq_shiggs' g1 s g2 m1 m2 =
[ ((LQ (m1,g1), SHiggs s, LQ (m2,-g2)), Scalar_Scalar_Scalar 1, G_LQ_S (m1,m2,g1,s,g2))]
let lq_shiggs g1 s g2 =
List.flatten ( Product.list2 (lq_shiggs' g1 s g2) [M1;M2] [M1;M2])
let lq_phiggs' g1 p g2 m1 m2 =
[ ((LQ (m1,g1), PHiggs p, LQ (m2,-g2)), Scalar_Scalar_Scalar 1, G_LQ_P (m1,m2,g1,p,g2))]
let lq_phiggs g1 p g2 =
List.flatten ( Product.list2 (lq_phiggs' g1 p g2) [M1;M2] [M1;M2])
let yuk_lqino_shiggs g1 s g2 =
[ ((LQino (-g1), SHiggs s, LQino g2), FBF (1, Psibar, SLR, Psi),
G_YUK_LQ_S (g1,s,g2)) ]
let yuk_lqino_phiggs g1 p g2 =
[ ((LQino (-g1), PHiggs p, LQino g2), FBF (1, Psibar, SLR, Psi),
G_YUK_LQ_P (g1,p,g2)) ]
(*** Daniel Wiesler: LQ - Neutralinos. ***)
let lqino_lq_neu' n g1 g2 m =
[ ((Neutralino n, LQ (m,-g1), LQino g2), FBF (1, Chibar, SLR, Psi),
G_LQ_NEU (m,g1,g2,n)) ]
let lqino_lq_neu n g1 g2 =
ThoList.flatmap (lqino_lq_neu' n g1 g2) [M1;M2]
let lqino_lq_neu2' n g1 g2 m =
[ ((LQino (-g2), LQ (m,g1), Neutralino n), FBF (1, Psibar, SLR, Chi),
G_LQ_NEU (m,g1,g2,n)) ]
let lqino_lq_neu2 n g1 g2 =
ThoList.flatmap (lqino_lq_neu2' n g1 g2) [M1;M2]
(*** Daniel Wiesler: LQ-LQino-Gluino ***)
let lqino_lq_gg' g1 g2 m =
[ ((Gluino, LQ (m,-g1), LQino g2), FBF (1, Chibar, SLR, Psi),
G_LQ_GG (m,g1,g2)) ]
let lqino_lq_gg g1 g2 =
ThoList.flatmap (lqino_lq_gg' g1 g2) [M1;M2]
(*** Daniel Wiesler: LQ - Gauge ***)
let col_lqino_currents g =
[ ((LQino (-g), Gl, LQino g), FBF ((-1), Psibar, V, Psi), Gs)]
let neutr_lqino_current g =
[ ((LQino (-g), Z, LQino g), FBF (1, Psibar, V, Psi), G_NLQC)]
let col_lq_currents m g =
[ ((Gl, LQ (m,-g), LQ (m,g)), Vector_Scalar_Scalar (-1), Gs)]
let lq_neutr_Z g m1 m2 =
[ ((Z, LQ (m1,-g), LQ (m2,g)), Vector_Scalar_Scalar (-1), G_ZLQ (g,m1,m2))]
let em_lq_currents g m =
[ ((Ga, LQ (m,-g), LQ (m,g)), Vector_Scalar_Scalar 1, Q_down)]
let em_lqino_currents g =
[ ((LQino (-g), Ga, LQino g), FBF (1, Psibar, V, Psi), Q_down)]
let gluon2_lq2' g m =
[ ((LQ (m,g), LQ (m,-g), Gl, Gl), Scalar2_Vector2 2, G_GlGlLQLQ)]
let gluon2_lq2 g =
ThoList.flatmap (gluon2_lq2' g) [M1;M2]
let lq_gauge4' g m =
[ ((Z, Z, LQ (m,g), LQ (m,-g)), Scalar2_Vector2 1, G_ZZLQLQ);
((Z, Ga, LQ (m,g), LQ (m,-g)), Scalar2_Vector2 1, G_ZPLQLQ);
((Ga, Ga, LQ (m,g), LQ (m,-g)), Scalar2_Vector2 1, G_PPLQLQ)]
let lq_gauge4 g =
ThoList.flatmap (lq_gauge4' g) [M1;M2]
let lq_gg_gauge2' g m =
[ ((Z, Gl, LQ (m,g), LQ (m,-g)), Scalar2_Vector2 1, G_ZGlLQLQ);
((Ga, Gl, LQ (m,g), LQ (m,-g)), Scalar2_Vector2 1, G_PGlLQLQ)]
let lq_gg_gauge2 g =
ThoList.flatmap (lq_gg_gauge2' g) [M1;M2]
let col_sfermion_currents g m =
[ ((Gl, Sup (m,-g), Sup (m,g)), Vector_Scalar_Scalar (-1), Gs);
((Gl, Sdown (m,-g), Sdown (m,g)), Vector_Scalar_Scalar (-1), Gs)]
(*** REVISED: Compatible with CD+. **FB*)
let triple_gauge =
[ ((Ga, Wm, Wp), Gauge_Gauge_Gauge 1, I_Q_W);
((Z, Wm, Wp), Gauge_Gauge_Gauge 1, I_G_ZWW);
((Gl, Gl, Gl), Gauge_Gauge_Gauge 1, I_G_S)]
(*** REVISED: Independent of the sign of CD. **FB*)
let gauge4 = Vector4 [(2, C_13_42); (-1, C_12_34); (-1, C_14_23)]
let minus_gauge4 = Vector4 [(-2, C_13_42); (1, C_12_34); (1, C_14_23)]
let quartic_gauge =
[ (Wm, Wp, Wm, Wp), gauge4, G_WWWW;
(Wm, Z, Wp, Z), minus_gauge4, G_ZZWW;
(Wm, Z, Wp, Ga), minus_gauge4, G_PZWW;
(Wm, Ga, Wp, Ga), minus_gauge4, G_PPWW;
(Gl, Gl, Gl, Gl), gauge4, G_SS]
(* The [Scalar_Vector_Vector] couplings do not depend on the choice of the
sign of the covariant derivative since they are quadratic in the
gauge couplings. *)
(* JR: Only the first charged Higgs. *)
(*** REVISED: Compatible with CD+. ***)
(*** Revision: 2005-03-10: first two vertices corrected. ***)
(*** REVISED: Felix Braam: Compact version using new COMBOS*)
(*** REVISED: Felix Braam: Couplings adjusted to FF-convention*)
let gauge_higgs_WPC p=
[ ((Wm, CHiggs HC1, PHiggs p), Vector_Scalar_Scalar 1, G_GH_WPC p);
((Wp, CHiggs HC1c, PHiggs p), Vector_Scalar_Scalar 1, G_GH_WPC p)]
let gauge_higgs_WSC s=
[((Wm, CHiggs HC1, SHiggs s),Vector_Scalar_Scalar 1, G_GH_WSC s);
((Wp, CHiggs HC1c, SHiggs s),Vector_Scalar_Scalar (-1), G_GH_WSC s)]
let gauge_higgs_ZSP s p =
[((Z, SHiggs s, PHiggs p),Vector_Scalar_Scalar 1, G_GH_ZSP (s,p))]
let gauge_higgs_WWS s=
((SHiggs s, Wp, Wm),Scalar_Vector_Vector 1, G_GH_WWS s)
let gauge_higgs_ZZS s=
((SHiggs s, Z, Z), Scalar_Vector_Vector 1, G_GH_ZZS s)
let gauge_higgs_ZCC =
((Z, CHiggs HC1, CHiggs HC1c),Vector_Scalar_Scalar 1, G_GH_ZCC )
let gauge_higgs_GaCC =
((Ga, CHiggs HC1, CHiggs HC1c),Vector_Scalar_Scalar 1, G_GH_GaCC )
let gauge_higgs =
ThoList.flatmap gauge_higgs_WPC [P1;P2] @
ThoList.flatmap gauge_higgs_WSC [S1;S2;S3] @
List.flatten (Product.list2 gauge_higgs_ZSP [S1;S2;S3] [P1;P2]) @
List.map gauge_higgs_WWS [S1;S2;S3] @
List.map gauge_higgs_ZZS [S1;S2;S3] @
[gauge_higgs_ZCC] @ [gauge_higgs_GaCC]
(*** REVISED: Compact version using new COMBOS*)
(*** REVISED: Couplings adjusted to FF-convention*)
let gauge_higgs4_ZZPP (p1,p2) =
((PHiggs p1, PHiggs p2, Z, Z), Scalar2_Vector2 1, G_GH4_ZZPP (p1,p2))
let gauge_higgs4_ZZSS (s1,s2) =
((SHiggs s1, SHiggs s2 , Z, Z), Scalar2_Vector2 1, G_GH4_ZZSS (s1,s2))
(* JR: Only the first charged Higgs. *)
let gauge_higgs4_ZZCC =
((CHiggs HC1, CHiggs HC1c, Z, Z), Scalar2_Vector2 1, G_GH4_ZZCC)
let gauge_higgs4_GaGaCC =
((CHiggs HC1, CHiggs HC1c, Ga, Ga), Scalar2_Vector2 1, G_GH4_GaGaCC)
let gauge_higgs4_ZGaCC =
((CHiggs HC1, CHiggs HC1c, Ga, Z), Scalar2_Vector2 1, G_GH4_ZGaCC )
let gauge_higgs4_WWCC =
((CHiggs HC1, CHiggs HC1c, Wp, Wm), Scalar2_Vector2 1, G_GH4_WWCC )
let gauge_higgs4_WWPP (p1,p2) =
((PHiggs p1, PHiggs p2, Wp, Wm), Scalar2_Vector2 1, G_GH4_WWPP (p1,p2))
let gauge_higgs4_WWSS (s1,s2) =
((SHiggs s1, SHiggs s2, Wp, Wm), Scalar2_Vector2 1, G_GH4_WWSS (s1,s2))
(* JR: Only the first charged Higgs. *)
let gauge_higgs4_ZWSC s =
[ ((CHiggs HC1, SHiggs s, Wm, Z), Scalar2_Vector2 1, G_GH4_ZWSC s);
((CHiggs HC1c, SHiggs s, Wp, Z), Scalar2_Vector2 1, G_GH4_ZWSC s)]
let gauge_higgs4_GaWSC s =
[ ((CHiggs HC1, SHiggs s, Wm, Ga), Scalar2_Vector2 1, G_GH4_GaWSC s);
((CHiggs HC1c, SHiggs s, Wp, Ga), Scalar2_Vector2 1, G_GH4_GaWSC s) ]
let gauge_higgs4_ZWPC p =
[ ((CHiggs HC1, PHiggs p, Wm, Z), Scalar2_Vector2 1, G_GH4_ZWPC p);
((CHiggs HC1c, PHiggs p, Wp, Z), Scalar2_Vector2 (-1), G_GH4_ZWPC p)]
let gauge_higgs4_GaWPC p =
[ ((CHiggs HC1, PHiggs p, Wm, Ga), Scalar2_Vector2 1, G_GH4_GaWPC p);
((CHiggs HC1c, PHiggs p, Wp, Ga), Scalar2_Vector2 (-1),
G_GH4_GaWPC p) ]
let gauge_higgs4 =
List.map gauge_higgs4_ZZPP (pairs [P1;P2]) @
List.map gauge_higgs4_ZZSS (pairs [S1;S2;S3]) @
[gauge_higgs4_ZZCC] @ [gauge_higgs4_GaGaCC] @
[gauge_higgs4_ZGaCC] @ [gauge_higgs4_WWCC] @
List.map gauge_higgs4_WWPP (pairs [P1;P2]) @
List.map gauge_higgs4_WWSS (pairs [S1;S2;S3]) @
ThoList.flatmap gauge_higgs4_ZWSC [S1;S2;S3] @
ThoList.flatmap gauge_higgs4_GaWSC [S1;S2;S3] @
ThoList.flatmap gauge_higgs4_ZWPC [P1;P2] @
ThoList.flatmap gauge_higgs4_GaWPC [P1;P2]
(*** Added by Felix Braam. ***)
let gauge_sfermion4' g m1 m2 =
[ ((Wp, Wm, Slepton (m1,g), Slepton (m2,-g)), Scalar2_Vector2 1,
G_WWSFSF (SL,g,m1,m2));
((Z, Ga, Slepton (m1,g), Slepton (m2,-g)), Scalar2_Vector2 1,
G_ZPSFSF (SL,g,m1,m2));
((Z, Z, Slepton (m1,g), Slepton (m2,-g)), Scalar2_Vector2 1,
G_ZZSFSF (SL,g,m1,m2));
((Wp, Wm, Sup (m1,g), Sup (m2,-g)), Scalar2_Vector2 1, G_WWSFSF
(SU,g,m1,m2));
((Wp, Wm, Sdown (m1,g), Sdown (m2,-g)), Scalar2_Vector2 1, G_WWSFSF
(SD,g,m1,m2));
((Z, Z, Sup (m1,g), Sup (m2,-g)), Scalar2_Vector2 1, G_ZZSFSF
(SU,g,m1,m2));
((Z, Z, Sdown (m1,g), Sdown (m2,-g)), Scalar2_Vector2 1, G_ZZSFSF
(SD,g,m1,m2));
((Z, Ga, Sup (m1,g), Sup (m2,-g)), Scalar2_Vector2 1, G_ZPSFSF
(SU,g,m1,m2));
((Z, Ga, Sdown (m1,g), Sdown (m2,-g)), Scalar2_Vector2 1, G_ZPSFSF
(SD,g,m1,m2)) ]
let gauge_sfermion4'' g m =
[ ((Wp, Ga, Slepton (m,g), Sneutrino (-g)), Scalar2_Vector2 1,
G_WPSLSN (false,g,m));
((Wm, Ga, Slepton (m,-g), Sneutrino g), Scalar2_Vector2 1,
G_WPSLSN (true,g,m));
((Wp, Z, Slepton (m,g), Sneutrino (-g)), Scalar2_Vector2 1,
G_WZSLSN (false,g,m));
((Wm, Z, Slepton (m,-g), Sneutrino g), Scalar2_Vector2 1,
G_WZSLSN (true,g,m));
((Ga, Ga, Slepton (m,g), Slepton (m,-g)), Scalar2_Vector2 1, G_PPSFSF SL);
((Ga, Ga, Sup (m,g), Sup (m,-g)), Scalar2_Vector2 1, G_PPSFSF SU);
((Ga, Ga, Sdown (m,g), Sdown (m,-g)), Scalar2_Vector2 1, G_PPSFSF SD)]
let gauge_sfermion4 g =
List.flatten (Product.list2 (gauge_sfermion4' g) [M1;M2] [M1;M2]) @
ThoList.flatmap (gauge_sfermion4'' g) [M1;M2] @
[ ((Wp, Wm, Sneutrino g, Sneutrino (-g)), Scalar2_Vector2 1, G_WWSFSF
(SN,g,M1,M1));
((Z, Z, Sneutrino g, Sneutrino (-g)), Scalar2_Vector2 1, G_ZZSFSF
(SN,g,M1,M1)) ]
(*** Modified by Felix Braam. ***)
let gauge_squark4' g h m1 m2 =
[ ((Wp, Ga, Sup (m1,-g), Sdown (m2,h)), Scalar2_Vector2 1, G_WPSUSD
(false,m1,m2,g,h));
((Wm, Ga, Sup (m1,g), Sdown (m2,-h)), Scalar2_Vector2 1, G_WPSUSD
(true,m1,m2,g,h));
((Wp, Z, Sup (m1,-g), Sdown (m2,h)), Scalar2_Vector2 1, G_WZSUSD
(false,m1,m2,g,h));
((Wm, Z, Sup (m1,g), Sdown (m2,-h)), Scalar2_Vector2 1, G_WZSUSD
(true,m1,m2,g,h)) ]
let gauge_squark4 g h = List.flatten (Product.list2 (gauge_squark4' g h)
[M1;M2] [M1;M2])
let gluon_w_squark' g h m1 m2 =
[ ((Gl, Wp, Sup (m1,-g), Sdown (m2,h)),
Scalar2_Vector2 1, G_GlWSUSD (false,m1,m2,g,h));
((Gl, Wm, Sup (m1,g), Sdown (m2,-h)),
Scalar2_Vector2 1, G_GlWSUSD (true,m1,m2,g,h)) ]
let gluon_w_squark g h =
List.flatten (Product.list2 (gluon_w_squark' g h) [M1;M2] [M1;M2])
(*** Modified by Felix Braam. ***)
let gluon_gauge_squark' g m1 m2 =
[ ((Gl, Z, Sup (m1,g), Sup (m2,-g)),
Scalar2_Vector2 2, G_GlZSFSF (SU,g,m1,m2));
((Gl, Z, Sdown (m1,g), Sdown (m2,-g)),
Scalar2_Vector2 2, G_GlZSFSF (SD,g,m1,m2)) ]
let gluon_gauge_squark'' g m =
[ ((Gl, Ga, Sup (m,g), Sup (m,-g)), Scalar2_Vector2 2, G_GlPSQSQ);
((Gl, Ga, Sdown (m,g), Sdown (m,-g)), Scalar2_Vector2 (-1), G_GlPSQSQ) ]
(*** Modified by Felix Braam. ***)
let gluon_gauge_squark g =
List.flatten (Product.list2 (gluon_gauge_squark' g) [M1;M2] [M1;M2]) @
ThoList.flatmap (gluon_gauge_squark'' g) [M1;M2]
let gluon2_squark2' g m =
[ ((Gl, Gl, Sup (m,g), Sup (m,-g)), Scalar2_Vector2 2, G_GlGlSQSQ);
((Gl, Gl, Sdown (m,g), Sdown (m,-g)), Scalar2_Vector2 2, G_GlGlSQSQ) ]
let gluon2_squark2 g =
ThoList.flatmap (gluon2_squark2' g) [M1;M2]
(* JR: Only the first charged Higgs. *)
(*** REVISED: Independent of the sign of CD. ***)
(*** REVISED: Felix Braam: Compact version using new COMBOS *)
(*** REVISED: Felix Braam: Couplings adjusted to FF-convention *)
let higgs_SCC s =
((CHiggs HC1, CHiggs HC1c, SHiggs s), Scalar_Scalar_Scalar 1,
G_H3_SCC s )
let higgs_SSS (s1,s2,s3)=
((SHiggs s1, SHiggs s2, SHiggs s3), Scalar_Scalar_Scalar 1,
G_H3_SSS (s1,s2,s3))
let higgs_SPP (p1,p2,s) =
((SHiggs s, PHiggs p1, PHiggs p2), Scalar_Scalar_Scalar 1,
G_H3_SPP (s,p1,p2))
let higgs =
List.map higgs_SCC [S1;S2;S3]@
List.map higgs_SSS (triples [S1;S2;S3])@
List.map higgs_SPP (two_and_one [P1;P2] [S1;S2;S3])
let higgs4 = []
(* The vertices of the type Higgs - Sfermion - Sfermion are independent of
the choice of the CD sign since they are quadratic in the gauge
coupling. *)
(* JR: Only the first charged Higgs. *)
(*** REVISED: Independent of the sign of CD. ***)
let higgs_sneutrino' s g =
((SHiggs s, Sneutrino g, Sneutrino (-g)), Scalar_Scalar_Scalar 1,
G_SFSFS (s,SN,g,M1,M1))
let higgs_sneutrino'' g m =
[((CHiggs HC1, Sneutrino (-g), Slepton (m,g)),
Scalar_Scalar_Scalar 1, G_HSNSL (false,g,m));
((CHiggs HC1c, Sneutrino g, Slepton (m,-g)), Scalar_Scalar_Scalar 1,
G_HSNSL (true,g,m))]
let higgs_sneutrino =
Product.list2 higgs_sneutrino' [S1;S2;S3] [1;2;3] @
List.flatten ( Product.list2 higgs_sneutrino'' [1;2;3] [M1;M2] )
(* Under the assumption that there is no mixing between the left- and
right-handed sfermions for the first two generations there is only a
coupling of the form Higgs - sfermion1 - sfermion2 for the third
generation. All the others are suppressed by $m_f/M_W$. *)
(*** REVISED: Independent of the sign of CD. ***)
let higgs_sfermion_S s g m1 m2 =
[ ((SHiggs s, Slepton (m1,g), Slepton (m2,-g)), Scalar_Scalar_Scalar 1,
G_SFSFS (s,SL,g,m1,m2));
((SHiggs s, Sup (m1,g), Sup (m2,-g)), Scalar_Scalar_Scalar 1,
G_SFSFS (s,SU,g,m1,m2));
((SHiggs s, Sdown (m1,g), Sdown (m2,-g)), Scalar_Scalar_Scalar 1,
G_SFSFS (s,SD,g,m1,m2))]
let higgs_sfermion' g m1 m2 =
(higgs_sfermion_S S1 g m1 m2) @ (higgs_sfermion_S S2 g m1 m2) @ (higgs_sfermion_S S3 g m1 m2)
let higgs_sfermion_P p g m1 m2 =
[ ((PHiggs p, Slepton (m1,g), Slepton (m2,-g)), Scalar_Scalar_Scalar 1,
G_SFSFP (p,SL,g,m1,m2));
((PHiggs p, Sup (m1,g), Sup (m2,-g)), Scalar_Scalar_Scalar 1,
G_SFSFP (p,SU,g,m1,m2));
((PHiggs p, Sdown (m1,g), Sdown (m2,-g)), Scalar_Scalar_Scalar 1,
G_SFSFP (p,SD,g,m1,m2)) ]
let higgs_sfermion'' g m1 m2 =
(higgs_sfermion_P P1 g m1 m2) @ (higgs_sfermion_P P2 g m1 m2)
let higgs_sfermion = List.flatten (Product.list3 higgs_sfermion' [1;2;3] [M1;M2] [M1;M2]) @
List.flatten (Product.list3 higgs_sfermion'' [1;2;3] [M1;M2] [M1;M2])
(* JR: Only the first charged Higgs. *)
(*** REVISED: Independent of the sign of CD. ***)
let higgs_squark' g h m1 m2 =
[ ((CHiggs HC1, Sup (m1,-g), Sdown (m2,h)), Scalar_Scalar_Scalar 1,
G_HSUSD (false,m1,m2,g,h));
((CHiggs HC1c, Sup (m1,g), Sdown (m2,-h)), Scalar_Scalar_Scalar 1,
G_HSUSD (true,m1,m2,g,h)) ]
let higgs_squark_a g h = higgs_squark' g h M1 M1
let higgs_squark_b (g,h) = List.flatten (Product.list2 (higgs_squark' g h)
[M1;M2] [M1;M2])
let higgs_squark =
List.flatten (Product.list2 higgs_squark_a [1;2] [1;2]) @
ThoList.flatmap higgs_squark_b [(1,3);(2,3);(3,3);(3,1);(3,2)]
let vertices3 =
(ThoList.flatmap electromagnetic_currents_3 [1;2;3] @
ThoList.flatmap electromagnetic_currents_2 [C1;C2] @
List.flatten (Product.list2 electromagnetic_sfermion_currents [1;2;3]
[M1;M2]) @
ThoList.flatmap neutral_currents [1;2;3] @
ThoList.flatmap neutral_sfermion_currents [1;2;3] @
ThoList.flatmap charged_currents [1;2;3] @
List.flatten (Product.list2 charged_slepton_currents [1;2;3]
[M1;M2]) @
(if Flags.ckm_present then
List.flatten (Product.list2 charged_quark_currents [1;2;3]
[1;2;3]) @
List.flatten (Product.list2 charged_squark_currents [1;2;3]
[1;2;3]) @
ThoList.flatmap yukawa_higgs_quark [(1,3);(2,3);(3,3);(3,1);(3,2)]
else
charged_quark_currents 1 1 @
charged_quark_currents 2 2 @
charged_quark_currents 3 3 @
charged_squark_currents 1 1 @
charged_squark_currents 2 2 @
charged_squark_currents 3 3 @
ThoList.flatmap yukawa_higgs_quark [(3,3)]) @
(*i ThoList.flatmap yukawa_higgs [1;2;3] @ i*)
yukawa_higgs 3 @ yukawa_n @
ThoList.flatmap yukawa_c [C1;C2] @
ThoList.flatmap yukawa_cq [C1;C2] @
List.flatten (Product.list2 charged_chargino_currents [N1;N2;N3;N4;N5]
[C1;C2]) @ triple_gauge @
ThoList.flatmap neutral_Z (pairs [N1;N2;N3;N4;N5]) @
Product.list2 charged_Z [C1;C2] [C1;C2] @
gauge_higgs @ higgs @ yukawa_higgs_2 @
(*i List.flatten (Product.list2 yukawa_higgs_quark [1;2;3] [1;2;3]) @ i*)
List.flatten (Product.list2 higgs_charg_neutr [N1;N2;N3;N4;N5] [C1;C2]) @
higgs_neutr @ higgs_sneutrino @ higgs_sfermion @
higgs_squark @ yukawa_v @
ThoList.flatmap col_currents [1;2;3] @
List.flatten (Product.list2 col_sfermion_currents [1;2;3] [M1;M2])) @
List.flatten (Product.list2 col_lq_currents [M1;M2] [1;2;3]) @
ThoList.flatmap col_lqino_currents [1;2;3] @
ThoList.flatmap em_lqino_currents [1;2;3] @
ThoList.flatmap neutr_lqino_current [1;2;3] @
List.flatten (Product.list3 yuk_lqino_se_uc1 [1;2;3] [1;2;3] [1;2;3]) @
List.flatten (Product.list3 yuk_lqino_se_uc2 [1;2;3] [1;2;3] [1;2;3]) @
List.flatten (Product.list3 yuk_lqino_ec_su1 [1;2;3] [1;2;3] [1;2;3]) @
List.flatten (Product.list3 yuk_lqino_ec_su2 [1;2;3] [1;2;3] [1;2;3]) @
List.flatten (Product.list3 yuk_lqino_sn_dc1 [1;2;3] [1;2;3] [1;2;3]) @
List.flatten (Product.list3 yuk_lqino_sn_dc2 [1;2;3] [1;2;3] [1;2;3]) @
List.flatten (Product.list3 yuk_lqino_nc_sd1 [1;2;3] [1;2;3] [1;2;3]) @
List.flatten (Product.list3 yuk_lqino_nc_sd2 [1;2;3] [1;2;3] [1;2;3]) @
List.flatten (Product.list3 yuk_lq_ec_uc [1;2;3] [1;2;3] [1;2;3]) @
List.flatten (Product.list3 yuk_lq_ec_uc2 [1;2;3] [1;2;3] [1;2;3]) @
List.flatten (Product.list3 yuk_lq_nc_dc [1;2;3] [1;2;3] [1;2;3]) @
List.flatten (Product.list3 yuk_lq_nc_dc2 [1;2;3] [1;2;3] [1;2;3]) @
List.flatten (Product.list3 lq_neutr_Z [1;2;3] [M1;M2] [M1;M2]) @
List.flatten (Product.list2 em_lq_currents [1;2;3] [M1;M2]) @
List.flatten (Product.list3 lq_shiggs [1;2;3] [S1;S2;S3;S4;S5;S6;S7;S8;S9] [1;2;3]) @
List.flatten (Product.list3 lq_phiggs [1;2;3] [P1;P2;P3;P4;P5;P6;P7] [1;2;3]) @
List.flatten (Product.list3 yuk_lqino_shiggs [1;2;3] [S1;S2;S3;S4;S5;S6;S7;S8;S9] [1;2;3]) @
List.flatten (Product.list3 yuk_lqino_phiggs [1;2;3] [P1;P2;P3;P4;P5;P6;P7] [1;2;3]) @
List.flatten (Product.list3 lqino_lq_neu nlist [1;2;3] [1;2;3]) @
List.flatten (Product.list3 lqino_lq_neu2 nlist [1;2;3] [1;2;3]) @
List.flatten (Product.list3 lq_se_su [1;2;3] [1;2;3] [1;2;3]) @
List.flatten (Product.list3 lq_snu_sd [1;2;3] [1;2;3] [1;2;3]) @
List.flatten (Product.list2 lqino_lq_gg [1;2;3] [1;2;3])
let vertices4 =
(quartic_gauge @ higgs4 @ gauge_higgs4 @
ThoList.flatmap gauge_sfermion4 [1;2;3] @
List.flatten (Product.list2 gauge_squark4 [1;2;3] [1;2;3]) @
ThoList.flatmap gluon2_squark2 [1;2;3] @
List.flatten (Product.list2 gluon_w_squark [1;2;3] [1;2;3]) @
ThoList.flatmap gluon_gauge_squark [1;2;3] @
ThoList.flatmap gluon2_lq2 [1;2;3] @
ThoList.flatmap lq_gauge4 [1;2;3] @
ThoList.flatmap lq_gg_gauge2 [1;2;3])
let vertices () = (vertices3, vertices4, [])
let table = F.of_vertices (vertices ())
let fuse2 = F.fuse2 table
let fuse3 = F.fuse3 table
let fuse = F.fuse table
let max_degree () = 4
(* SLHA2-Nomenclature for neutral Higgses *)
let flavor_of_string s =
match s with
| "e-" -> L 1 | "e+" -> L (-1)
| "mu-" -> L 2 | "mu+" -> L (-2)
| "tau-" -> L 3 | "tau+" -> L (-3)
| "nue" -> N 1 | "nuebar" -> N (-1)
| "numu" -> N 2 | "numubar" -> N (-2)
| "nutau" -> N 3 | "nutaubar" -> N (-3)
| "se1-" -> Slepton (M1,1) | "se1+" -> Slepton (M1,-1)
| "smu1-" -> Slepton (M1,2) | "smu1+" -> Slepton (M1,-2)
| "stau1-" -> Slepton (M1,3) | "stau1+" -> Slepton (M1,-3)
| "se2-" -> Slepton (M2,1) | "se2+" -> Slepton (M2,-1)
| "smu2-" -> Slepton (M2,2) | "smu2+" -> Slepton (M2,-2)
| "stau2-" -> Slepton (M2,3) | "stau2+" -> Slepton (M2,-3)
| "snue" -> Sneutrino 1 | "snue*" -> Sneutrino (-1)
| "snumu" -> Sneutrino 2 | "snumu*" -> Sneutrino (-2)
| "snutau" -> Sneutrino 3 | "snutau*" -> Sneutrino (-3)
| "u" -> U 1 | "ubar" -> U (-1)
| "c" -> U 2 | "cbar" -> U (-2)
| "t" -> U 3 | "tbar" -> U (-3)
| "d" -> D 1 | "dbar" -> D (-1)
| "s" -> D 2 | "sbar" -> D (-2)
| "b" -> D 3 | "bbar" -> D (-3)
| "A" -> Ga | "Z" | "Z0" -> Z
| "W+" -> Wp | "W-" -> Wm
| "gl" | "g" -> Gl
| "h01" -> SHiggs S1 | "h02" -> SHiggs S2 | "h03" -> SHiggs S3
| "A01" -> PHiggs P1 | "A02" -> PHiggs P2
| "h04" -> SHiggs S4 | "h05" -> SHiggs S5 | "h06" -> SHiggs S6
| "A03" -> PHiggs P3 | "A04" -> PHiggs P4
| "h07" -> SHiggs S7 | "h08" -> SHiggs S8 | "h09" -> SHiggs S9
| "A05" -> PHiggs P5 | "A06" -> PHiggs P6 | "A07" -> PHiggs P7
(* JR: Only the first charged Higgs. *)
| "H+" -> CHiggs HC1 | "H-" -> CHiggs HC1c
| "su1" -> Sup (M1,1) | "su1c" -> Sup (M1,-1)
| "sc1" -> Sup (M1,2) | "sc1c" -> Sup (M1,-2)
| "st1" -> Sup (M1,3) | "st1c" -> Sup (M1,-3)
| "su2" -> Sup (M2,1) | "su2c" -> Sup (M2,-1)
| "sc2" -> Sup (M2,2) | "sc2c" -> Sup (M2,-2)
| "st2" -> Sup (M2,3) | "st2c" -> Sup (M2,-3)
| "sgl" | "sg" -> Gluino
| "sd1" -> Sdown (M1,1) | "sd1c" -> Sdown (M1,-1)
| "ss1" -> Sdown (M1,2) | "ss1c" -> Sdown (M1,-2)
| "sb1" -> Sdown (M1,3) | "sb1c" -> Sdown (M1,-3)
| "sd2" -> Sdown (M2,1) | "sd2c" -> Sdown (M2,-1)
| "ss2" -> Sdown (M2,2) | "ss2c" -> Sdown (M2,-2)
| "sb2" -> Sdown (M2,3) | "sb2c" -> Sdown (M2,-3)
| "neu1" -> Neutralino N1 | "neu2" -> Neutralino N2
| "neu3" -> Neutralino N3 | "neu4" -> Neutralino N4
| "neu5" -> Neutralino N5 | "neu6" -> Neutralino N6
| "neu7" -> Neutralino N7 | "neu8" -> Neutralino N8
| "neu9" -> Neutralino N9 | "neu10" -> Neutralino N10
| "neu11" -> Neutralino N11
| "ch1+" -> Chargino C1 | "ch2+" -> Chargino C2
| "ch1-" -> Chargino C1c | "ch2-" -> Chargino C2c
| "ch3+" -> Chargino C3 | "ch4+" -> Chargino C4
| "ch3-" -> Chargino C3c | "ch4-" -> Chargino C4c
| "lq11" -> LQ (M1,1) | "lq11c" -> LQ (M1,-1)
| "lq12" -> LQ (M2,1) | "lq12c" -> LQ (M2,-1)
| "lq21" -> LQ (M1,2) | "lq21c" -> LQ (M1,-2)
| "lq22" -> LQ (M2,2) | "lq22c" -> LQ (M2,-2)
| "lq31" -> LQ (M1,3) | "lq31c" -> LQ (M1,-3)
| "lq32" -> LQ (M2,3) | "lq32c" -> LQ (M2,-3)
| "lqino1" -> LQino 1 | "lqino1b" -> LQino (-1)
| "lqino2" -> LQino 2 | "lqino2b" -> LQino (-2)
| "lqino3" -> LQino 3 | "lqino3b" -> LQino (-3)
| s -> invalid_arg ("HUBABUBA: %s Modellib_PSSSM.ExtMSSM.flavor_of_string:" ^ s)
let flavor_to_string = function
| L 1 -> "e-" | L (-1) -> "e+"
| L 2 -> "mu-" | L (-2) -> "mu+"
| L 3 -> "tau-" | L (-3) -> "tau+"
| N 1 -> "nue" | N (-1) -> "nuebar"
| N 2 -> "numu" | N (-2) -> "numubar"
| N 3 -> "nutau" | N (-3) -> "nutaubar"
| U 1 -> "u" | U (-1) -> "ubar"
| U 2 -> "c" | U (-2) -> "cbar"
| U 3 -> "t" | U (-3) -> "tbar"
| U _ -> invalid_arg
"Modellib_PSSSM.ExtMSSM.flavor_to_string: invalid up type quark"
| D 1 -> "d" | D (-1) -> "dbar"
| D 2 -> "s" | D (-2) -> "sbar"
| D 3 -> "b" | D (-3) -> "bbar"
| D _ -> invalid_arg
"Modellib_PSSSM.ExtMSSM.flavor_to_string: invalid down type quark"
| Gl -> "gl" | Gluino -> "sgl"
| Ga -> "A" | Z -> "Z"
| Wp -> "W+" | Wm -> "W-"
| SHiggs S1 -> "h01" | SHiggs S2 -> "h02" | SHiggs S3 -> "h03"
| PHiggs P1 -> "A01" | PHiggs P2 -> "A02"
| SHiggs S4 -> "h04" | SHiggs S5 -> "h05" | SHiggs S6 -> "h06"
| PHiggs P3 -> "A03" | PHiggs P4 -> "A04"
| SHiggs S7 -> "h07" | SHiggs S8 -> "h08" | SHiggs S9 -> "h09"
| PHiggs P5 -> "A05" | PHiggs P6 -> "A06" | PHiggs P7 -> "A07"
(* JR: Only the first charged Higgs. *)
| CHiggs HC1 -> "H+" | CHiggs HC1c -> "H-"
| CHiggs HC2 -> "HX_1+" | CHiggs HC2c -> "HX_1-"
| CHiggs HC3 -> "HX_2+" | CHiggs HC3c -> "HX_2-"
| CHiggs HC4 -> "HX_3+" | CHiggs HC4c -> "HX_3-"
| CHiggs HC5 -> "HX_4+" | CHiggs HC5c -> "HX_4-"
| Slepton (M1,1) -> "se1-" | Slepton (M1,-1) -> "se1+"
| Slepton (M1,2) -> "smu1-" | Slepton (M1,-2) -> "smu1+"
| Slepton (M1,3) -> "stau1-" | Slepton (M1,-3) -> "stau1+"
| Slepton (M2,1) -> "se2-" | Slepton (M2,-1) -> "se2+"
| Slepton (M2,2) -> "smu2-" | Slepton (M2,-2) -> "smu2+"
| Slepton (M2,3) -> "stau2-" | Slepton (M2,-3) -> "stau2+"
| Sneutrino 1 -> "snue" | Sneutrino (-1) -> "snue*"
| Sneutrino 2 -> "snumu" | Sneutrino (-2) -> "snumu*"
| Sneutrino 3 -> "snutau" | Sneutrino (-3) -> "snutau*"
| Sup (M1,1) -> "su1" | Sup (M1,-1) -> "su1c"
| Sup (M1,2) -> "sc1" | Sup (M1,-2) -> "sc1c"
| Sup (M1,3) -> "st1" | Sup (M1,-3) -> "st1c"
| Sup (M2,1) -> "su2" | Sup (M2,-1) -> "su2c"
| Sup (M2,2) -> "sc2" | Sup (M2,-2) -> "sc2c"
| Sup (M2,3) -> "st2" | Sup (M2,-3) -> "st2c"
| Sdown (M1,1) -> "sd1" | Sdown (M1,-1) -> "sd1c"
| Sdown (M1,2) -> "ss1" | Sdown (M1,-2) -> "ss1c"
| Sdown (M1,3) -> "sb1" | Sdown (M1,-3) -> "sb1c"
| Sdown (M2,1) -> "sd2" | Sdown (M2,-1) -> "sd2c"
| Sdown (M2,2) -> "ss2" | Sdown (M2,-2) -> "ss2c"
| Sdown (M2,3) -> "sb2" | Sdown (M2,-3) -> "sb2c"
| Neutralino n -> "neu" ^ string_of_neu n
| Chargino C1 -> "ch1+" | Chargino C1c -> "ch1-"
| Chargino C2 -> "ch2+" | Chargino C2c -> "ch2-"
| Chargino C3 -> "ch3+" | Chargino C3c -> "ch3-"
| Chargino C4 -> "ch4+" | Chargino C4c -> "ch4-"
| LQ (M1,1) -> "lq11" | LQ (M1,-1) -> "lq11c"
| LQ (M2,1) -> "lq12" | LQ (M2,-1) -> "lq12c"
| LQ (M1,2) -> "lq21" | LQ (M1,-2) -> "lq21c"
| LQ (M2,2) -> "lq22" | LQ (M2,-2) -> "lq22c"
| LQ (M1,3) -> "lq31" | LQ (M1,-3) -> "lq31c"
| LQ (M2,3) -> "lq32" | LQ (M2,-3) -> "lq32c"
| LQino 1 -> "lqino1" | LQino (-1) -> "lqino1b"
| LQino 2 -> "lqino2" | LQino (-2) -> "lqino2b"
| LQino 3 -> "lqino3" | LQino (-3) -> "lqino3b"
| _ -> invalid_arg "Modellib_PSSSM.ExtMSSM.flavor_to_string"
let flavor_to_TeX = function
| L 1 -> "e^-" | L (-1) -> "e^+"
| L 2 -> "\\mu^-" | L (-2) -> "\\mu^+"
| L 3 -> "\\tau^-" | L (-3) -> "\\tau^+"
| N 1 -> "\\nu_e" | N (-1) -> "\\bar{\\nu}_e"
| N 2 -> "\\nu_\\mu" | N (-2) -> "\\bar{\\nu}_\\mu"
| N 3 -> "\\nu_\\tau" | N (-3) -> "\\bar{\\nu}_\\tau"
| U 1 -> "u" | U (-1) -> "\\bar{u}"
| U 2 -> "c" | U (-2) -> "\\bar{c}"
| U 3 -> "t" | U (-3) -> "\\bar{t}"
| D 1 -> "d" | D (-1) -> "\\bar{d}"
| D 2 -> "s" | D (-2) -> "\\bar{s}"
| D 3 -> "b" | D (-3) -> "\\bar{b}"
| L _ -> invalid_arg
"Modellib_PSSSM.ExtMSSM.flavor_to_TeX: invalid lepton"
| N _ -> invalid_arg
"Modellib_PSSSM.ExtMSSM.flavor_to_TeX: invalid neutrino"
| U _ -> invalid_arg
"Modellib_PSSSM.ExtMSSM.flavor_to_TeX: invalid up type quark"
| D _ -> invalid_arg
"Modellib_PSSSM.ExtMSSM.flavor_to_TeX: invalid down type quark"
| Gl -> "g" | Gluino -> "\\widetilde{g}"
| Ga -> "\\gamma" | Z -> "Z" | Wp -> "W^+" | Wm -> "W^-"
| SHiggs S1 -> "S_1" | SHiggs S2 -> "S_2" | SHiggs S3 -> "S_3"
| SHiggs S4 -> "S_4" | SHiggs S5 -> "S_5" | SHiggs S6 -> "S_6"
| SHiggs S7 -> "S_7" | SHiggs S8 -> "S_8" | SHiggs S9 -> "S_9"
| PHiggs P1 -> "P_1" | PHiggs P2 -> "P_2" | PHiggs P3 -> "P_3"
| PHiggs P4 -> "P_4" | PHiggs P5 -> "P_5" | PHiggs P6 -> "P_6"
| PHiggs P7 -> "P_7"
| CHiggs HC1 -> "H^+" | CHiggs HC1c -> "H^-"
| CHiggs HC2 -> "X_{H,1}^+" | CHiggs HC2c -> "X_{H,1}^-"
| CHiggs HC3 -> "X_{H,2}^+" | CHiggs HC3c -> "X_{H,2}^-"
| CHiggs HC4 -> "X_{H,3}^+" | CHiggs HC4c -> "X_{H,3}^-"
| CHiggs HC5 -> "X_{H,4}^+" | CHiggs HC5c -> "X_{H,4}^-"
| Slepton (M1,1) -> "\\widetilde{e}_1^-"
| Slepton (M1,-1) -> "\\widetilde{e}_1^+"
| Slepton (M1,2) -> "\\widetilde{\\mu}_1^-"
| Slepton (M1,-2) -> "\\widetilde{\\mu}_1^+"
| Slepton (M1,3) -> "\\widetilde{\\tau}_1^-"
| Slepton (M1,-3) -> "\\widetilde{\\tau}_1^+"
| Slepton (M2,1) -> "\\widetilde{e}_2^-"
| Slepton (M2,-1) -> "\\widetilde{e}_2^+"
| Slepton (M2,2) -> "\\widetilde{\\mu}_2^-"
| Slepton (M2,-2) -> "\\widetilde{\\mu}_2^+"
| Slepton (M2,3) -> "\\widetilde{\\tau}_2^-"
| Slepton (M2,-3) -> "\\widetilde{\\tau}_2^+"
| Sneutrino 1 -> "\\widetilde{\\nu}_e"
| Sneutrino (-1) -> "\\widetilde{\\nu}_e^*"
| Sneutrino 2 -> "\\widetilde{\\nu}_\\mu"
| Sneutrino (-2) -> "\\widetilde{\\nu}_\\mu^*"
| Sneutrino 3 -> "\\widetilde{\\nu}_\\tau"
| Sneutrino (-3) -> "\\widetilde{\\nu}_\\tau^*"
| Sup (M1,1) -> "\\widetilde{u}_1"
| Sup (M1,-1) -> "\\widetilde{u}_1^*"
| Sup (M1,2) -> "\\widetilde{c}_1"
| Sup (M1,-2) -> "\\widetilde{c}_1^*"
| Sup (M1,3) -> "\\widetilde{t}_1"
| Sup (M1,-3) -> "\\widetilde{t}_1^*"
| Sup (M2,1) -> "\\widetilde{u}_2"
| Sup (M2,-1) -> "\\widetilde{u}_2^*"
| Sup (M2,2) -> "\\widetilde{c}_2"
| Sup (M2,-2) -> "\\widetilde{c}_2^*"
| Sup (M2,3) -> "\\widetilde{t}_2"
| Sup (M2,-3) -> "\\widetilde{t}_2^*"
| Sdown (M1,1) -> "\\widetilde{d}_1"
| Sdown (M1,-1) -> "\\widetilde{d}_1^*"
| Sdown (M1,2) -> "\\widetilde{s}_1"
| Sdown (M1,-2) -> "\\widetilde{s}_1^*"
| Sdown (M1,3) -> "\\widetilde{b}_1"
| Sdown (M1,-3) -> "\\widetilde{b}_1^*"
| Sdown (M2,1) -> "\\widetilde{d}_2"
| Sdown (M2,-1) -> "\\widetilde{d}_2^*"
| Sdown (M2,2) -> "\\widetilde{s}_2"
| Sdown (M2,-2) -> "\\widetilde{s}_2^*"
| Sdown (M2,3) -> "\\widetilde{b}_2"
| Sdown (M2,-3) -> "\\widetilde{b}_2^*"
| Neutralino N1 -> "\\widetilde{\\chi}^0_1"
| Neutralino N2 -> "\\widetilde{\\chi}^0_2"
| Neutralino N3 -> "\\widetilde{\\chi}^0_3"
| Neutralino N4 -> "\\widetilde{\\chi}^0_4"
| Neutralino N5 -> "\\widetilde{\\chi}^0_5"
| Neutralino N6 -> "\\widetilde{\\chi}^0_6"
| Neutralino N7 -> "\\widetilde{\\chi}^0_7"
| Neutralino N8 -> "\\widetilde{\\chi}^0_8"
| Neutralino N9 -> "\\widetilde{\\chi}^0_9"
| Neutralino N10 -> "\\widetilde{\\chi}^0_{10}"
| Neutralino N11 -> "\\widetilde{\\chi}^0_{11}"
| Slepton _ -> invalid_arg
"Modellib_PSSSM.ExtMSSM.flavor_to_TeX: invalid slepton"
| Sneutrino _ -> invalid_arg
"Modellib_PSSSM.ExtMSSM.flavor_to_TeX: invalid sneutrino"
| Sup _ -> invalid_arg
"Modellib_PSSSM.ExtMSSM.flavor_to_TeX: invalid up type squark"
| Sdown _ -> invalid_arg
"Modellib_PSSSM.ExtMSSM.flavor_to_TeX: invalid down type squark"
| Chargino C1 -> "\\widetilde{\\chi}_1^+"
| Chargino C1c -> "\\widetilde{\\chi}_1^-"
| Chargino C2 -> "\\widetilde{\\chi}_2^+"
| Chargino C2c -> "\\widetilde{\\chi}_2^-"
| Chargino C3 -> "\\widetilde{\\chi}_3^+"
| Chargino C3c -> "\\widetilde{\\chi}_3^-"
| Chargino C4 -> "\\widetilde{\\chi}_4^+"
| Chargino C4c -> "\\widetilde{\\chi}_4^-"
| LQ (M1,1) -> "D_{1,,1}" | LQ (M1,-1) -> "D_{1,,1}^*"
| LQ (M2,1) -> "D_{1,,2}" | LQ (M2,-1) -> "D_{1,,2}^*"
| LQ (M1,2) -> "D_{2,,1}" | LQ (M1,-2) -> "D_{2,,1}^*"
| LQ (M2,2) -> "D_{2,,2}" | LQ (M2,-2) -> "D_{2,,2}^*"
| LQ (M1,3) -> "D_{3,,1}" | LQ (M1,-3) -> "D_{3,,1}^*"
| LQ (M2,3) -> "D_{3,,2}" | LQ (M2,-3) -> "D_{3,,2}^*"
| LQino 1 -> "\\widetilde{D}_1" | LQino (-1) -> "\\bar\\widetilde{D}_1"
| LQino 2 -> "\\widetilde{D}_2" | LQino (-2) -> "\\bar\\widetilde{D}_2"
| LQino 3 -> "\\widetilde{D}_3" | LQino (-3) -> "\\bar\\widetilde{D}_3"
| LQ _ -> invalid_arg
"Modellib_PSSSM.ExtMSSM.flavor_to_TeX: invalid leptoquark type"
| LQino _ -> invalid_arg
"Modellib_PSSSM.ExtMSSM.flavor_to_TeX: invalid leptoquarkino type"
let flavor_symbol = function
| L g when g > 0 -> "l" ^ string_of_int g
| L g -> "l" ^ string_of_int (abs g) ^ "b"
| N g when g > 0 -> "n" ^ string_of_int g
| N g -> "n" ^ string_of_int (abs g) ^ "b"
| U g when g > 0 -> "u" ^ string_of_int g
| U g -> "u" ^ string_of_int (abs g) ^ "b"
| D g when g > 0 -> "d" ^ string_of_int g
| D g -> "d" ^ string_of_int (abs g) ^ "b"
| Gl -> "gl"
| Ga -> "a" | Z -> "z"
| Wp -> "wp" | Wm -> "wm"
| Slepton (M1,g) when g > 0 -> "sl1" ^ string_of_int g
| Slepton (M1,g) -> "sl1c" ^ string_of_int (abs g)
| Slepton (M2,g) when g > 0 -> "sl2" ^ string_of_int g
| Slepton (M2,g) -> "sl2c" ^ string_of_int (abs g)
| Sneutrino g when g > 0 -> "sn" ^ string_of_int g
| Sneutrino g -> "snc" ^ string_of_int (abs g)
| Sup (M1,g) when g > 0 -> "su1" ^ string_of_int g
| Sup (M1,g) -> "su1c" ^ string_of_int (abs g)
| Sup (M2,g) when g > 0 -> "su2" ^ string_of_int g
| Sup (M2,g) -> "su2c" ^ string_of_int (abs g)
| Sdown (M1,g) when g > 0 -> "sd1" ^ string_of_int g
| Sdown (M1,g) -> "sd1c" ^ string_of_int (abs g)
| Sdown (M2,g) when g > 0 -> "sd2" ^ string_of_int g
| Sdown (M2,g) -> "sd2c" ^ string_of_int (abs g)
| Neutralino n -> "neu" ^ (string_of_neu n)
| Chargino c when (int_of_char c) > 0 -> "cp" ^ string_of_char c
| Chargino c -> "cm" ^ string_of_int (abs (int_of_char c))
| Gluino -> "sgl"
| SHiggs s -> "h0" ^ (string_of_shiggs s)
| PHiggs p -> "A0" ^ (string_of_phiggs p)
| CHiggs HC1 -> "hp" | CHiggs HC1c -> "hm"
| CHiggs _ -> invalid_arg "charged Higgs not yet implemented"
| LQ (M1,g) when g > 0 -> "lq" ^ string_of_int g ^ "1"
| LQ (M1,g) -> "lq" ^ string_of_int (abs g) ^ "1c"
| LQ (M2,g) when g > 0 -> "lq" ^ string_of_int g ^ "2"
| LQ (M2,g) -> "lq" ^ string_of_int (abs g) ^ "2c"
| LQino g when g > 0 -> "lqino" ^ string_of_int g
| LQino g -> "lqino" ^ string_of_int (abs g) ^ "b"
let pdg = function
| L g when g > 0 -> 9 + 2*g
| L g -> - 9 + 2*g
| N g when g > 0 -> 10 + 2*g
| N g -> - 10 + 2*g
| U g when g > 0 -> 2*g
| U g -> 2*g
| D g when g > 0 -> - 1 + 2*g
| D g -> 1 + 2*g
| Gl -> 21
| Ga -> 22 | Z -> 23
| Wp -> 24 | Wm -> (-24)
| SHiggs S1 -> 25 | SHiggs S2 -> 35 | PHiggs P1 -> 36
(* JR: Only the first charged Higgs. *)
| CHiggs HC1 -> 37 | CHiggs HC1c -> (-37)
| CHiggs _ -> invalid_arg "charged Higgs not yet implemented"
| Slepton (M1,g) when g > 0 -> 1000009 + 2*g
| Slepton (M1,g) -> - 1000009 + 2*g
| Slepton (M2,g) when g > 0 -> 2000009 + 2*g
| Slepton (M2,g) -> - 2000009 + 2*g
| Sneutrino g when g > 0 -> 1000010 + 2*g
| Sneutrino g -> - 1000010 + 2*g
| Sup (M1,g) when g > 0 -> 1000000 + 2*g
| Sup (M1,g) -> - 1000000 + 2*g
| Sup (M2,g) when g > 0 -> 2000000 + 2*g
| Sup (M2,g) -> - 2000000 + 2*g
| Sdown (M1,g) when g > 0 -> 999999 + 2*g
| Sdown (M1,g) -> - 999999 + 2*g
| Sdown (M2,g) when g > 0 -> 1999999 + 2*g
| Sdown (M2,g) -> - 1999999 + 2*g
| Gluino -> 1000021
(* JR: only the first two charginos. *)
| Chargino C1 -> 1000024 | Chargino C1c -> (-1000024)
| Chargino C2 -> 1000037 | Chargino C2c -> (-1000037)
| Chargino C3 -> 1000039 | Chargino C3c -> (-1000039)
| Chargino C4 -> 1000041 | Chargino C4c -> (-1000041)
| Neutralino N1 -> 1000022 | Neutralino N2 -> 1000023
| Neutralino N3 -> 1000025 | Neutralino N4 -> 1000035
(* According to SLHA2 (not anymore ?!?)*)
| Neutralino N5 -> 1000045 | Neutralino N6 -> 1000046
| Neutralino N7 -> 1000047 | Neutralino N8 -> 1000048
| Neutralino N9 -> 1000049 | Neutralino N10 -> 1000050
| Neutralino N11 -> 1000051
| PHiggs P2 -> 46 | PHiggs P3 -> 47 | PHiggs P4 -> 48
| PHiggs P5 -> 49 | PHiggs P6 -> 50 | PHiggs P7 -> 51
| SHiggs S3 -> 45 | SHiggs S4 -> 52 | SHiggs S5 -> 53
| SHiggs S6 -> 54 | SHiggs S7 -> 55 | SHiggs S8 -> 56
| SHiggs S9 -> 57
| LQ (M1,g) when g > 0 -> 1000059 + g
| LQ (M1,g) -> - 1000059 + g
| LQ (M2,g) when g > 0 -> 2000059 + g
| LQ (M2,g) -> - 2000059 + g
| LQino g when g > 0 -> 59 + g
| LQino g -> -59 + g
(* We must take care of the pdg numbers for the two different kinds of
sfermions in the MSSM. The particle data group in its Monte Carlo particle
numbering scheme takes only into account mixtures of the third generation
squarks and the stau. For the other sfermions we will use the number of the
lefthanded field for the lighter mixed state and the one for the righthanded
for the heavier. Below are the official pdg numbers from the Particle
Data Group. In order not to produce arrays with some million entries in
the Fortran code for the masses and the widths we introduce our private
pdg numbering scheme which only extends not too far beyond 42.
Our private scheme then has the following pdf numbers (for the sparticles
the subscripts $L/R$ and $1/2$ are taken synonymously):
\begin{center}
\renewcommand{\arraystretch}{1.2}
\begin{tabular}{|r|l|l|}\hline
$d$ & down-quark & 1 \\\hline
$u$ & up-quark & 2 \\\hline
$s$ & strange-quark & 3 \\\hline
$c$ & charm-quark & 4 \\\hline
$b$ & bottom-quark & 5 \\\hline
$t$ & top-quark & 6 \\\hline\hline
$e^-$ & electron & 11 \\\hline
$\nu_e$ & electron-neutrino & 12 \\\hline
$\mu^-$ & muon & 13 \\\hline
$\nu_\mu$ & muon-neutrino & 14 \\\hline
$\tau^-$ & tau & 15 \\\hline
$\nu_\tau$ & tau-neutrino & 16 \\\hline\hline
$g$ & gluon & (9) 21 \\\hline
$\gamma$ & photon & 22 \\\hline
$Z^0$ & Z-boson & 23 \\\hline
$W^+$ & W-boson & 24 \\\hline\hline
$h^0$ & light Higgs boson & 25 \\\hline
$H^0$ & heavy Higgs boson & 35 \\\hline
$A^0$ & pseudoscalar Higgs & 36 \\\hline
$H^+$ & charged Higgs & 37 \\\hline\hline
$\tilde{d}_L$ & down-squark 1 & 41 \\\hline
$\tilde{u}_L$ & up-squark 1 & 42 \\\hline
$\tilde{s}_L$ & strange-squark 1 & 43 \\\hline
$\tilde{c}_L$ & charm-squark 1 & 44 \\\hline
$\tilde{b}_L$ & bottom-squark 1 & 45 \\\hline
$\tilde{t}_L$ & top-squark 1 & 46 \\\hline
$\tilde{d}_R$ & down-squark 2 & 47 \\\hline
$\tilde{u}_R$ & up-squark 2 & 48 \\\hline
$\tilde{s}_R$ & strange-squark 2 & 49 \\\hline
$\tilde{c}_R$ & charm-squark 2 & 50 \\\hline
$\tilde{b}_R$ & bottom-squark 2 & 51 \\\hline
$\tilde{t}_R$ & top-squark 2 & 52 \\\hline\hline
$\tilde{e}_L$ & selectron 1 & 53 \\\hline
$\tilde{\nu}_{e,L}$ & electron-sneutrino & 54 \\\hline
$\tilde{\mu}_L$ & smuon 1 & 55 \\\hline
$\tilde{\nu}_{\mu,L}$ & muon-sneutrino & 56 \\\hline
$\tilde{\tau}_L$ & stau 1 & 57 \\\hline
$\tilde{\nu}_{\tau,L}$ & tau-sneutrino & 58 \\\hline
$\tilde{e}_R$ & selectron 2 & 59 \\\hline
$\tilde{\mu}_R$ & smuon 2 & 61 \\\hline
$\tilde{\tau}_R$ & stau 2 & 63 \\\hline\hline
$\tilde{g}$ & gluino & 64 \\\hline
$\tilde{\chi}^0_1$ & neutralino 1 & 65 \\\hline
$\tilde{\chi}^0_2$ & neutralino 2 & 66 \\\hline
$\tilde{\chi}^0_3$ & neutralino 3 & 67 \\\hline
$\tilde{\chi}^0_4$ & neutralino 4 & 68 \\\hline
$\tilde{\chi}^0_4$ & neutralino 5 & 69 \\\hline
$\tilde{\chi4}^+_1$ & chargino 1 & 70 \\\hline
$\tilde{\chi}^+_2$ & chargino 2 & 71 \\\hline\hline
$a$ & pseudoscalar & 72 \\\hline
$s$ & scalar singlet & 73 \\\hline
$\tilde{G}$ & gravitino & -- \\\hline\hline
\end{tabular}
\end{center} *)
let pdg_mw = function
| L g when g > 0 -> 9 + 2*g
| L g -> - 9 + 2*g
| N g when g > 0 -> 10 + 2*g
| N g -> - 10 + 2*g
| U g when g > 0 -> 2*g
| U g -> 2*g
| D g when g > 0 -> - 1 + 2*g
| D g -> 1 + 2*g
| Gl -> 21
| Ga -> 22 | Z -> 23
| Wp -> 24 | Wm -> (-24)
| SHiggs S1 -> 25 | SHiggs S2 -> 35 | PHiggs P1 -> 36
(* JR: Only the first charged Higgs. *)
| CHiggs HC1 -> 37 | CHiggs HC1c -> (-37)
| CHiggs _ -> invalid_arg "charged Higgs not yet implemented"
| Sup (M1,g) when g > 0 -> 40 + 2*g
| Sup (M1,g) -> - 40 + 2*g
| Sup (M2,g) when g > 0 -> 46 + 2*g
| Sup (M2,g) -> - 46 + 2*g
| Sdown (M1,g) when g > 0 -> 39 + 2*g
| Sdown (M1,g) -> - 39 + 2*g
| Sdown (M2,g) when g > 0 -> 45 + 2*g
| Sdown (M2,g) -> - 45 + 2*g
| Slepton (M1,g) when g > 0 -> 51 + 2*g
| Slepton (M1,g) -> - 51 + 2*g
| Slepton (M2,g) when g > 0 -> 57 + 2*g
| Slepton (M2,g) -> - 57 + 2*g
| Sneutrino g when g > 0 -> 52 + 2*g
| Sneutrino g -> - 52 + 2*g
| Gluino -> 64
(* JR: Only the first two charginos. *)
| Chargino C1 -> 70 | Chargino C1c -> (-70)
| Chargino C2 -> 71 | Chargino C2c -> (-71)
| Chargino C3 -> 106 | Chargino C3c -> (-106)
| Chargino C4 -> 107 | Chargino C4c -> (-107)
| Neutralino N1 -> 65 | Neutralino N2 -> 66
| Neutralino N3 -> 67 | Neutralino N4 -> 68
| Neutralino N5 -> 69 | Neutralino N6 -> 100
| Neutralino N7 -> 101 | Neutralino N8 -> 102
| Neutralino N9 -> 103 | Neutralino N10 -> 104
| Neutralino N11 -> 105
| PHiggs P2 -> 72 | PHiggs P3 -> 89 | PHiggs P4 -> 90
| PHiggs P5 -> 91 | PHiggs P6 -> 92 | PHiggs P7 -> 93
| SHiggs S3 -> 73 | SHiggs S4 -> 94 | SHiggs S5 -> 95
| SHiggs S6 -> 96 | SHiggs S7 -> 97 | SHiggs S8 -> 98
| SHiggs S9 -> 99
| LQ (M1,g) when g > 0 -> 78 + 2*g
| LQ (M1,g) -> - 78 + 2*g
| LQ (M2,g) when g > 0 -> 79 + 2*g
| LQ (M2,g) -> - 79 + 2*g
| LQino g when g > 0 -> 85 + g
| LQino g -> - 85 + g
let mass_symbol f =
"mass(" ^ string_of_int (abs (pdg_mw f)) ^ ")"
let width_symbol f =
"width(" ^ string_of_int (abs (pdg_mw f)) ^ ")"
let conj_symbol = function
| false, str -> str
| true, str -> str ^ "_c"
let constant_symbol = function
| E -> "e" | G -> "g" | G_Z -> "gz"
| Q_lepton -> "qlep" | Q_up -> "qup" | Q_down -> "qdwn"
| Q_charg -> "qchar"
| G_NC_lepton -> "gnclep" | G_NC_neutrino -> "gncneu"
| G_NC_up -> "gncup" | G_NC_down -> "gncdwn"
| G_CC -> "gcc"
| G_CCQ (vc,g1,g2) -> conj_symbol (vc, "g_ccq" ) ^ "("
^ string_of_int g1 ^ "," ^ string_of_int g2 ^ ")"
| I_Q_W -> "iqw" | I_G_ZWW -> "igzww"
| G_WWWW -> "gw4" | G_ZZWW -> "gzzww"
| G_PZWW -> "gpzww" | G_PPWW -> "gppww"
| G_GH4_ZZPP (p1,p2) -> "g_ZZA0A0(" ^ string_of_phiggs p1 ^ "," ^
string_of_phiggs p2 ^ ")"
| G_GH4_ZZSS (s1,s2) -> "g_ZZh0h0(" ^ string_of_shiggs s1 ^ "," ^
string_of_shiggs s2 ^ ")"
| G_GH4_ZZCC -> "g_zzhphm"
| G_GH4_GaGaCC -> "g_AAhphm"
| G_GH4_ZGaCC -> "g_zAhphm"
| G_GH4_WWCC -> "g_wwhphm"
| G_GH4_WWPP (p1,p2) -> "g_WWA0A0(" ^ string_of_phiggs p1 ^ "," ^
string_of_phiggs p2 ^ ")"
| G_GH4_WWSS (s1,s2) -> "g_WWh0h0(" ^ string_of_shiggs s1 ^ "," ^
string_of_shiggs s2 ^ ")"
| G_GH4_ZWSC s -> "g_ZWhph0(" ^ string_of_shiggs s ^")"
| G_GH4_GaWSC s -> "g_AWhph0(" ^ string_of_shiggs s ^")"
| G_GH4_ZWPC p -> "g_ZWhpA0(" ^ string_of_phiggs p ^")"
| G_GH4_GaWPC p -> "g_AWhpA0(" ^ string_of_phiggs p ^")"
| G_CICIS (n1,n2,s) -> "g_neuneuh0(" ^ string_of_neu n1 ^ "," ^
string_of_neu n2 ^ "," ^ string_of_shiggs s ^ ")"
| G_CICIP (n1,n2,p) -> "g_neuneuA0(" ^ string_of_neu n1 ^ "," ^
string_of_neu n2 ^ "," ^ string_of_phiggs p ^ ")"
| G_H3_SCC s -> "g_h0hphm(" ^ string_of_shiggs s ^ ")"
| G_H3_SPP (s,p1,p2) -> "g_h0A0A0(" ^ string_of_shiggs s ^ "," ^
string_of_phiggs p1 ^ "," ^ string_of_phiggs p2 ^ ")"
| G_H3_SSS (s1,s2,s3) -> "g_h0h0h0(" ^ string_of_shiggs s1 ^ "," ^
string_of_shiggs s2 ^ "," ^ string_of_shiggs s3 ^ ")"
| G_CSC (c1,c2,s) -> "g_chchh0(" ^ string_of_char c1 ^ "," ^
string_of_char c2 ^ "," ^ string_of_shiggs s ^ ")"
| G_CPC (c1,c2,p) -> "g_chchA0(" ^ string_of_char c1 ^ "," ^
string_of_char c2 ^ "," ^ string_of_phiggs p ^")"
| G_YUK_FFS (f1,f2,s) -> "g_yuk_h0_" ^ string_of_fermion_type f1 ^
string_of_fermion_type f2 ^ "(" ^ string_of_shiggs s ^ "," ^
string_of_fermion_gen f1 ^ ")"
| G_YUK_FFP (f1,f2,p) -> "g_yuk_A0_" ^ string_of_fermion_type f1 ^
string_of_fermion_type f2 ^ "(" ^ string_of_phiggs p ^ "," ^
string_of_fermion_gen f1 ^ ")"
| G_YUK_LCN g -> "g_yuk_hp_ln(" ^ string_of_int g ^ ")"
| G_NWC (n,c) -> "g_nwc(" ^ string_of_char c ^ "," ^ string_of_neu n ^ ")"
| G_CWN (c,n) -> "g_cwn(" ^ string_of_char c ^ "," ^ string_of_neu n ^ ")"
| G_SLSNW (vc,g,m) -> conj_symbol (vc, "g_wslsn") ^ "(" ^ string_of_int g
^ "," ^ string_of_sfm m ^ ")"
| G_NZN (n1,n2) -> "g_zneuneu(" ^ string_of_neu n1 ^ ","
^ string_of_neu n2 ^ ")"
| G_CZC (c1,c2) -> "g_zchch(" ^ string_of_char c1 ^ ","
^ string_of_char c2 ^ ")"
| Gs -> "gs"
| G_YUK_UCD (n,m) -> "g_yuk_hp_ud(" ^ string_of_int n ^ "," ^
string_of_int m ^ ")"
| G_YUK_DCU (n,m) -> "g_yuk_hm_du(" ^ string_of_int n ^ "," ^
string_of_int m ^ ")"
| G_YUK_N (vc,f,n,sf,m) -> conj_symbol (vc, "g_yuk_neu_" ^
string_of_fermion_type f ^ string_of_sff sf) ^ "(" ^
string_of_fermion_gen f ^ "," ^ string_of_neu n ^ "," ^
string_of_sfm m ^ ")"
| G_YUK_G (vc,f,sf,m) -> conj_symbol (vc, "g_yuk_gluino_" ^
string_of_fermion_type f ^ string_of_sff sf) ^ "(" ^
string_of_fermion_gen f ^ "," ^ string_of_sfm m ^ ")"
| G_YUK_C (vc,f,c,sf,m) -> conj_symbol (vc, "g_yuk_char_" ^
string_of_fermion_type f ^ string_of_sff sf) ^ "(" ^
string_of_fermion_gen f ^ "," ^ string_of_char c ^ "," ^
string_of_sfm m ^ ")"
| G_YUK_Q (vc,g1,f,c,sf,m) -> conj_symbol (vc, "g_yuk_char_" ^
string_of_fermion_type f ^ string_of_sff sf) ^"("^string_of_int g1 ^
"," ^ string_of_fermion_gen f ^ "," ^ string_of_char c ^ "," ^
string_of_sfm m ^ ")"
| G_WPSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "g_wA_susd") ^ "(" ^
string_of_int g1 ^ "," ^ string_of_int g2 ^ "," ^ string_of_sfm m1 ^
"," ^ string_of_sfm m2 ^ ")"
| G_WZSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "g_wz_susd") ^ "(" ^
string_of_int g1 ^ "," ^ string_of_int g2 ^ "," ^ string_of_sfm m1
^ "," ^ string_of_sfm m2 ^ ")"
(* 3vertex: Higgs-Gauge a la Franke-Fraas *)
(* Nomenclature consistent with [flavor_of_string] *)
| G_GH_ZSP (s,p) -> "g_zh0a0(" ^ string_of_shiggs s ^ "," ^
string_of_phiggs p ^ ")"
| G_GH_WSC s -> "g_Whph0(" ^ string_of_shiggs s ^ ")"
| G_GH_WPC p -> "g_WhpA0(" ^ string_of_phiggs p^ ")"
| G_GH_ZZS s -> "g_ZZh0(" ^ string_of_shiggs s ^ ")"
| G_GH_WWS s -> "g_WWh0(" ^ string_of_shiggs s ^ ")"
| G_GH_ZCC -> "g_Zhmhp"
| G_GH_GaCC -> "g_Ahmhp"
| G_ZSF (f,g,m1,m2) -> "g_z" ^ string_of_sff f ^ string_of_sff f ^ "(" ^
string_of_int g ^ "," ^ string_of_sfm m1 ^ "," ^ string_of_sfm m2 ^ ")"
| G_HSNSL (vc,g,m) -> conj_symbol (vc, "g_hp_sl" ^ string_of_sfm m ^ "sn1" )
^ "(" ^ string_of_int g ^ ")"
| G_GlGlSQSQ -> "g_gg_sqsq"
| G_PPSFSF f -> "g_AA_" ^ string_of_sff f ^ string_of_sff f
| G_ZZSFSF (f,g,m1,m2) -> "g_zz_" ^ string_of_sff f ^string_of_sff f ^ "(" ^
string_of_int g ^ "," ^ string_of_sfm m1 ^ "," ^ string_of_sfm m2 ^ ")"
| G_ZPSFSF (f,g,m1,m2) -> "g_zA_" ^ string_of_sff f ^string_of_sff f ^ "("
^ string_of_int g ^","^ string_of_sfm m1 ^ "," ^ string_of_sfm m2 ^ ")"
| G_GlPSQSQ -> "g_gA_sqsq"
| G_GlZSFSF (f,g,m1,m2) -> "g_gz_" ^ string_of_sff f ^ string_of_sff f ^
"(" ^ string_of_int g ^ "," ^ string_of_sfm m1 ^ "," ^ string_of_sfm
m2 ^ ")"
| G_GlWSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "g_gw_susd") ^ "(" ^
string_of_int g1 ^ "," ^string_of_int g2 ^ "," ^ string_of_sfm m1 ^ ","
^ string_of_sfm m2 ^ ")"
| G_strong -> "gs" | G_SS -> "gs**2"
| I_G_S -> "igs"
| G_NHC (vc,n,c) -> conj_symbol(vc,"g_neuhmchar") ^ "(" ^
string_of_neu n ^ "," ^ string_of_char c ^ ")"
| G_WWSFSF (f,g,m1,m2) -> "g_ww_" ^ string_of_sff f ^ string_of_sff f ^
"(" ^ string_of_int g ^ "," ^ string_of_sfm m1 ^ "," ^ string_of_sfm m2
^ ")"
| G_WPSLSN (vc,g,m) -> conj_symbol (vc, "g_wA_slsn") ^"("^ string_of_int g
^ "," ^ string_of_sfm m ^ ")"
| G_WZSLSN (vc,g,m) -> conj_symbol (vc, "g_wz_slsn") ^ "(" ^ string_of_int
g ^ "," ^ string_of_sfm m ^ ")"
| G_SFSFS (s,f,g,m1,m2) -> "g_h0_"^ string_of_sff f ^ string_of_sfm m1
^ string_of_sff f ^ string_of_sfm m2 ^ "(" ^ string_of_shiggs s ^ "," ^
string_of_int g ^ ")"
| G_SFSFP (p,f,g,m1,m2) -> "g_A0_"^ string_of_sff f ^ string_of_sfm m1
^ string_of_sff f ^ string_of_sfm m2 ^ "(" ^ string_of_phiggs p ^ "," ^
string_of_int g ^ ")"
| G_HSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "g_hp_su" ^ string_of_sfm m1
^ "sd" ^ string_of_sfm m2 ) ^ "(" ^ string_of_int g1 ^ ","
^ string_of_int g2 ^ ")"
| G_WSQ (vc,g1,g2,m1,m2) -> conj_symbol (vc, "g_wsusd") ^ "("
^ string_of_int g1 ^ "," ^ string_of_int g2 ^ "," ^ string_of_sfm m1 ^
"," ^ string_of_sfm m2 ^ ")"
| G_YUK_LQ_S (g1,s,g3) -> "g_yuk_lq_s(" ^ string_of_int g1 ^ "," ^
string_of_shiggs s ^"," ^ string_of_int g3 ^")"
| G_YUK_LQ_P (g1,p,g3) -> "g_yuk_lq_p(" ^ string_of_int g1 ^ "," ^
string_of_phiggs p ^ "," ^ string_of_int g3 ^ ")"
| G_LQ_NEU (m,g1,g2,n) -> "g_lq_neu(" ^ string_of_sfm m ^ "," ^
string_of_int g1 ^ "," ^ string_of_int g2 ^ "," ^ string_of_neu n ^ ")"
| G_LQ_GG (m,g1,g2) -> "g_lq_gg(" ^ string_of_sfm m ^ "," ^
string_of_int g1 ^ "," ^ string_of_int g2 ^ ")"
| G_LQ_EC_UC (vc,m,g1,g2,g3) -> conj_symbol(vc,"g_lq_ec_uc") ^ "(" ^
string_of_sfm m ^ "," ^ string_of_int g1 ^ "," ^ string_of_int g2 ^ ","
^ string_of_int g3 ^ ")"
| G_LQ_SSU (m1,m2,m3,g1,g2,g3) -> "g_lq_sst(" ^ string_of_sfm m1 ^ "," ^
string_of_sfm m2 ^ "," ^ string_of_sfm m3 ^ "," ^ string_of_int g1 ^ "," ^
string_of_int g2 ^ "," ^ string_of_int g3 ^ ")"
| G_LQ_SSD (m1,m2,g1,g2,g3) -> "g_lq_ssta(" ^ string_of_sfm m1 ^ "," ^
string_of_sfm m2 ^ "," ^ string_of_int g1 ^ "," ^ string_of_int g2 ^
"," ^ string_of_int g3 ^ ")"
| G_LQ_S (m1,m2,g1,s,g2) -> "g_lq_s(" ^ string_of_sfm m1 ^ "," ^ string_of_sfm m2 ^ ","
^ string_of_int g1 ^ "," ^ string_of_shiggs s ^ "," ^ string_of_int g2 ^ ")"
| G_LQ_P (m1,m2,g1,p,g2) -> "g_lq_s(" ^ string_of_sfm m1 ^ "," ^ string_of_sfm m2 ^ ","
^ string_of_int g1 ^ "," ^ string_of_phiggs p ^ "," ^ string_of_int g2 ^ ")"
| G_ZLQ (g,m1,m2) -> "g_zlqlq(" ^ string_of_int g ^ "," ^
string_of_sfm m1 ^ "," ^ string_of_sfm m2 ^ ")"
| G_ZZLQLQ -> "g_zz_lqlq"
| G_ZPLQLQ -> "g_zA_lqlq"
| G_PPLQLQ -> "g_AA_lqlq"
| G_ZGlLQLQ -> "g_zg_lqlq"
| G_PGlLQLQ -> "g_Ag_lqlq"
| G_GlGlLQLQ -> "g_gg_lqlq"
| G_NLQC -> "g_nlqc"
end
(*i
* Local Variables:
* mode:caml
* indent-tabs-mode:nil
* page-delimiter:"^(\\* .*\n"
* End:
i*)
Index: trunk/src/omega/src/modellib_PSSSM.mli
===================================================================
--- trunk/src/omega/src/modellib_PSSSM.mli (revision 2698)
+++ trunk/src/omega/src/modellib_PSSSM.mli (revision 2699)
@@ -1,45 +1,45 @@
(* $Id$
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. *)
(* \thocwmodulesection{Extended Supersymmetric Models} *)
(* We do not introduce the possibility here of using four point couplings
or not. We simply add the relevant and leave the rest out. No
possibility for Goldstone bosons is given. But we allow for CKM mixing.
*)
module type extMSSM_flags =
sig
val ckm_present : bool
end
module PSSSM : extMSSM_flags
module PSSSM_QCD : extMSSM_flags
-module ExtMSSM : functor (F: extMSSM_flags) -> Model.T with module Ch = Charges.Null
+module ExtMSSM : functor (F: extMSSM_flags) -> Model.T with module Ch = Charges.QQ
(*i
* Local Variables:
* mode:caml
* indent-tabs-mode:nil
* page-delimiter:"^(\\* .*\n"
* End:
i*)
Index: trunk/src/omega/src/modellib_MSSM.ml
===================================================================
--- trunk/src/omega/src/modellib_MSSM.ml (revision 2698)
+++ trunk/src/omega/src/modellib_MSSM.ml (revision 2699)
@@ -1,2589 +1,2642 @@
(* $Id$
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. *)
(* $Id$ *)
let rcs_file = RCS.parse "Modellib_MSSM" ["MSSM"]
{ RCS.revision = "$Revision$";
RCS.date = "$Date$";
RCS.author = "$Author$";
RCS.source
= "$URL$" }
(* \thocwmodulesection{Minimal Supersymmetric Standard Model} *)
module type MSSM_flags =
sig
val include_goldstone : bool
val include_four : bool
val ckm_present : bool
val gravitino : bool
end
module MSSM_no_goldstone : MSSM_flags =
struct
let include_goldstone = false
let include_four = true
let ckm_present = false
let gravitino = false
end
module MSSM_goldstone : MSSM_flags =
struct
let include_goldstone = true
let include_four = true
let ckm_present = false
let gravitino = false
end
module MSSM_no_4 : MSSM_flags =
struct
let include_goldstone = false
let include_four = false
let ckm_present = false
let gravitino = false
end
module MSSM_no_4_ckm : MSSM_flags =
struct
let include_goldstone = false
let include_four = false
let ckm_present = true
let gravitino = false
end
module MSSM_Grav : MSSM_flags =
struct
let include_goldstone = false
let include_four = false
let ckm_present = false
let gravitino = true
end
module MSSM (Flags : MSSM_flags) =
struct
let rcs = RCS.rename rcs_file "Modellib_MSSM.MSSM"
[ "MSSM" ]
open Coupling
let default_width = ref Timelike
let use_fudged_width = ref false
let options = Options.create
[ "constant_width", Arg.Unit (fun () -> default_width := Constant),
"use constant width (also in t-channel)";
"fudged_width", Arg.Set use_fudged_width,
"use fudge factor for charge particle width";
"custom_width", Arg.String (fun f -> default_width := Custom f),
"use custom width";
"cancel_widths", Arg.Unit (fun () -> default_width := Vanishing),
"use vanishing width"]
type gen =
| G of int | GG of gen*gen
let rec string_of_gen = function
| G n when n > 0 -> string_of_int n
| G n -> string_of_int (abs n) ^ "c"
| GG (g1,g2) -> string_of_gen g1 ^ "_" ^ string_of_gen g2
(* With this we distinguish the flavour. *)
type sff =
| SL | SN | SU | SD
let string_of_sff = function
| SL -> "sl" | SN -> "sn" | SU -> "su" | SD -> "sd"
(* With this we distinguish the mass eigenstates. At the moment we have to cheat
a little bit for the sneutrinos. Because we are dealing with massless
neutrinos there is only one sort of sneutrino. *)
type sfm =
| M1 | M2
let string_of_sfm = function
| M1 -> "1" | M2 -> "2"
(* We also introduce special types for the charginos and neutralinos. *)
type char =
| C1 | C2 | C1c | C2c
type neu =
| N1 | N2 | N3 | N4
let int_of_char = function
| C1 -> 1 | C2 -> 2 | C1c -> -1 | C2c -> -2
let string_of_char = function
| C1 -> "1" | C2 -> "2" | C1c -> "-1" | C2c -> "-2"
let conj_char = function
| C1 -> C1c | C2 -> C2c | C1c -> C1 | C2c -> C2
let string_of_neu = function
| N1 -> "1" | N2 -> "2" | N3 -> "3" | N4 -> "4"
(* Also we need types to distinguish the Higgs bosons. We follow the
conventions of Kuroda, which means
\begin{align}
\label{eq:higgs3}
H_1 &=
\begin{pmatrix}
\frac{1}{\sqrt{2}}
\bigl(
v_1 + H^0 \cos\alpha - h^0
\sin\alpha + \ii A^0 \sin\beta - \ii \phi^0 \cos\beta
\bigr) \\
H^- \sin\beta - \phi^- \cos\beta
\end{pmatrix},
\\ & \notag \\
H_2 & =
\begin{pmatrix}
H^+ \cos\beta + \phi^+ \sin\beta \\
\frac{1}{\sqrt{2}}
\bigl(
v_2 + H^0 \sin\alpha + h^0 \cos\alpha + \ii A^0 \cos\beta +
\ii \phi^0 \sin\beta
\bigr)
\end{pmatrix}
\label{eq:higgs4}
\end{align}
This is a different sign convention compared to, e.g.,
Weinberg's volume iii. We will refer to it as [GS+].
*)
type higgs =
| H1 (* the light scalar Higgs *)
| H2 (* the heavy scalar Higgs *)
| H3 (* the pseudoscalar Higgs *)
| H4 (* the charged Higgs *)
| H5 (* the neutral Goldstone boson *)
| H6 (* the charged Goldstone boson *)
| DH of higgs*higgs
let rec string_of_higgs = function
| H1 -> "h1" | H2 -> "h2" | H3 -> "h3" | H4 -> "h4"
| H5 -> "p1" | H6 -> "p2"
| DH (h1,h2) -> string_of_higgs h1 ^ string_of_higgs h2
type flavor =
| L of int | N of int
| U of int | D of int
| Sup of sfm*int | Sdown of sfm*int
| Ga | Wp | Wm | Z | Gl
| Slepton of sfm*int | Sneutrino of int
| Neutralino of neu | Chargino of char
| Gluino | Grino
| Phip | Phim | Phi0 | H_Heavy | H_Light | Hp | Hm | A
type gauge = unit
let gauge_symbol () =
failwith "Modellib_MSSM.MSSM.gauge_symbol: internal error"
(* At this point we will forget graviton and -tino. *)
let lep_family g = [ L g; N g; Slepton (M1,g);
Slepton (M2,g); Sneutrino g ]
let family g =
[ L g; N g; Slepton (M1,g); Slepton (M2,g); Sneutrino g;
U g; D g; Sup (M1,g); Sup (M2,g); Sdown (M1,g);
Sdown (M2,g)]
let external_flavors'' =
[ "1st Generation", ThoList.flatmap family [1; -1];
"2nd Generation", ThoList.flatmap family [2; -2];
"3rd Generation", ThoList.flatmap family [3; -3];
"Gauge Bosons", [Ga; Z; Wp; Wm; Gl];
"Charginos", [Chargino C1; Chargino C2; Chargino C1c; Chargino C2c];
"Neutralinos", [Neutralino N1; Neutralino N2; Neutralino N3;
Neutralino N4];
"Higgs Bosons", [H_Heavy; H_Light; Hp; Hm; A];
"Gluinos", [Gluino]]
let external_flavors' =
if Flags.gravitino then external_flavors'' @ ["Gravitino", [Grino]]
else
external_flavors''
let external_flavors () =
if Flags.include_goldstone then external_flavors' @ ["Goldstone Bosons",
[Phip; Phim; Phi0]]
else
external_flavors'
let flavors () = ThoList.flatmap snd (external_flavors ())
let spinor n =
if n >= 0 then
Spinor
else if
n <= 0 then
ConjSpinor
else
invalid_arg "Modellib_MSSM.MSSM.spinor: internal error"
let lorentz = function
| L g -> spinor g | N g -> spinor g
| U g -> spinor g | D g -> spinor g
| Chargino c -> spinor (int_of_char c)
| Ga -> Vector
(*i | Ga -> Ward_Vector i*)
| Gl -> Vector
| Wp | Wm | Z -> Massive_Vector
| H_Heavy | H_Light | Hp | Hm | A -> Scalar
| Phip | Phim | Phi0 -> Scalar
| Sup _ | Sdown _ | Slepton _ | Sneutrino _ -> Scalar
| Neutralino _ -> Majorana
| Gluino -> Majorana
| Grino -> Vectorspinor
let color = function
| U g -> Color.SUN (if g > 0 then 3 else -3)
| Sup (m,g) -> Color.SUN (if g > 0 then 3 else -3)
| D g -> Color.SUN (if g > 0 then 3 else -3)
| Sdown (m,g) -> Color.SUN (if g > 0 then 3 else -3)
| Gl | Gluino -> Color.AdjSUN 3
| _ -> Color.Singlet
let prop_spinor n =
if n >= 0 then
Prop_Spinor
else if
n <=0 then
Prop_ConjSpinor
else
invalid_arg "Modellib_MSSM.MSSM.prop_spinor: internal error"
let propagator = function
| L g -> prop_spinor g | N g -> prop_spinor g
| U g -> prop_spinor g | D g -> prop_spinor g
| Chargino c -> prop_spinor (int_of_char c)
| Ga | Gl -> Prop_Feynman
| Wp | Wm | Z -> Prop_Unitarity
| H_Heavy | H_Light | Hp | Hm | A -> Prop_Scalar
| Phip | Phim | Phi0 -> if Flags.include_goldstone then Prop_Scalar
else Only_Insertion
| Slepton _ | Sneutrino _ | Sup _ | Sdown _ -> Prop_Scalar
| Gluino -> Prop_Majorana | Neutralino _ -> Prop_Majorana
| Grino -> Only_Insertion
(* Note, that we define the gravitino only as an insertion since when using propagators
we are effectively going to a higher order in the gravitational coupling. This would
enforce us to also include higher-dimensional vertices with two gravitinos for
a consistent power counting in $1/M_{\text{Planck}}$. *)
(*i | Grino -> Prop_Vectorspinor i*)
(* Optionally, ask for the fudge factor treatment for the widths of
charged particles. Currently, this only applies to $W^\pm$ and top. *)
let width f =
if !use_fudged_width then
match f with
| Wp | Wm | U 3 | U (-3) -> Fudged
| _ -> !default_width
else
!default_width
(* For the Goldstone bosons we adopt the conventions of the Kuroda paper.
\begin{subequations}
\begin{equation}
H_1 \equiv \begin{pmatrix} \left( v_1 + H^0 \cos\alpha - h^0 \sin
\alpha + \ii A^0 \sin\beta - \ii \cos\beta \phi^0 \right) / \sqrt{2} \\
H^- \sin\beta - \phi^- \cos\beta \end{pmatrix}
\end{equation}
\begin{equation}
H_2 \equiv \begin{pmatrix} H^+ \cos\beta + \phi^+ \sin\beta \\ \left(
v_2 + H^0 \sin\alpha + h^0 \cos\alpha + \ii A^0 \cos\beta + \ii
\phi^0 \sin\beta \right) / \sqrt{2} \end{pmatrix}
\end{equation}
\end{subequations}
*)
let goldstone = function
| Wp -> Some (Phip, Coupling.Const 1)
| Wm -> Some (Phim, Coupling.Const 1)
| Z -> Some (Phi0, Coupling.Const 1)
| _ -> None
let conjugate = function
| L g -> L (-g) | N g -> N (-g)
| U g -> U (-g) | D g -> D (-g)
| Sup (m,g) -> Sup (m,-g)
| Sdown (m,g) -> Sdown (m,-g)
| Slepton (m,g) -> Slepton (m,-g)
| Sneutrino g -> Sneutrino (-g)
| Gl -> Gl (* | Gl0 -> Gl0 *)
| Ga -> Ga | Z -> Z | Wp -> Wm | Wm -> Wp
| H_Heavy -> H_Heavy | H_Light -> H_Light | A -> A
| Hp -> Hm | Hm -> Hp
| Phip -> Phim | Phim -> Phip | Phi0 -> Phi0
| Gluino -> Gluino
| Grino -> Grino
| Neutralino n -> Neutralino n | Chargino c -> Chargino (conj_char c)
let fermion = function
| L g -> if g > 0 then 1 else -1
| N g -> if g > 0 then 1 else -1
| U g -> if g > 0 then 1 else -1
| D g -> if g > 0 then 1 else -1
| Gl | Ga | Z | Wp | Wm -> 0 (* | Gl0 -> 0 *)
| H_Heavy | H_Light | Hp | Hm | A -> 0
| Phip | Phim | Phi0 -> 0
| Neutralino _ -> 2
| Chargino c -> if (int_of_char c) > 0 then 1 else -1
| Sup _ -> 0 | Sdown _ -> 0
| Slepton _ -> 0 | Sneutrino _ -> 0
| Gluino | Grino -> 2
(* Because the O'Caml compiler only allows 248 constructors we must divide the
constants into subgroups of constants, e.g. for the Higgs couplings. In the
MSSM there are a lot of angles among the parameters, the Weinberg-angle, the
angle describing the Higgs vacuum structure, the mixing angle of the real
parts of the Higgs dubletts, the mixing angles of the sfermions. Therefore we
are going to define the trigonometric functions of those angles not as
constants but as functors of the angels. Sums and differences of angles are
only used as arguments for the $\alpha$ and $\beta$ angles, so it makes no
sense to define special functions for differences and sums of angles. *)
type angle =
| Thw | Al | Be | Th_SF of sff*int | Delta | CKM_12 | CKM_13 | CKM_23
let string_of_angle = function
| Thw -> "thw" | Al -> "al" | Be -> "be" | Delta -> "d"
| CKM_12 -> "ckm12" | CKM_13 -> "ckm13" | CKM_23 -> "ckm23"
| Th_SF (f,g) -> "th" ^ string_of_sff f ^ string_of_int g
(* We introduce a Boolean type vc as a pseudonym for Vertex Conjugator to
distinguish between vertices containing complex mixing matrices like the
CKM--matrix or the sfermion or neutralino/chargino--mixing matrices, which
have to become complex conjugated. The true--option stands for the conjugated
vertex, the false--option for the unconjugated vertex. *)
type vc = bool
type constant =
| Unit | Pi | Alpha_QED | Sin2thw
| Sin of angle | Cos of angle | E | G | Vev | Tanb | Tana
| Cos2be | Cos2al | Sin2be | Sin2al | Sin4al | Sin4be | Cos4be
| Cosapb | Cosamb | Sinapb | Sinamb | Cos2am2b | Sin2am2b
| Eidelta
| Mu | AU of int | AD of int | AL of int
| V_CKM of int*int | M_SF of sff*int*sfm*sfm
| M_V of char*char (* left chargino mixing matrix *)
| M_U of char*char (* right chargino mixing matrix *)
| M_N of neu*neu (* neutralino mixing matrix *)
| V_0 of neu*neu | A_0 of neu*neu | V_P of char*char | A_P of char*char
| L_CN of char*neu | R_CN of char*neu | L_NC of neu*char | R_NC of neu*char
(*i | L_NF of neu*sff*sfm | R_NF of neu*sff*sfm i*)
| S_NNH1 of neu*neu | P_NNH1 of neu*neu
| S_NNH2 of neu*neu | P_NNH2 of neu*neu
| S_NNA of neu*neu | P_NNA of neu*neu
| S_NNG of neu*neu | P_NNG of neu*neu
| L_CNG of char*neu | R_CNG of char*neu
| L_NCH of neu*char | R_NCH of neu*char
| Q_lepton | Q_up | Q_down | Q_charg
| G_Z | G_CC | G_CCQ of vc*int*int
| G_NC_neutrino | G_NC_lepton | G_NC_up | G_NC_down
| I_Q_W | I_G_ZWW | G_WWWW | G_ZZWW | G_PZWW | G_PPWW
| G_strong | G_SS | I_G_S | G_S_Sqrt
| Gs
| M of flavor | W of flavor
| G_NZN of neu*neu | G_CZC of char*char
| G_YUK of int*int
| G_YUK_1 of int*int | G_YUK_2 of int*int | G_YUK_3 of int*int
| G_YUK_4 of int*int | G_NHC of neu*char | G_CHN of char*neu
| G_YUK_C of vc*int*char*sff*sfm
| G_YUK_Q of vc*int*int*char*sff*sfm
| G_YUK_N of vc*int*neu*sff*sfm
| G_YUK_G of vc*int*sff*sfm
| G_NGC of neu*char | G_CGN of char*neu
| SUM_1
| G_NWC of neu*char | G_CWN of char*neu
| G_CH1C of char*char | G_CH2C of char*char | G_CAC of char*char
| G_CGC of char*char
| G_SWS of vc*int*int*sfm*sfm
| G_SLSNW of vc*int*sfm
| G_ZSF of sff*int*sfm*sfm
| G_CICIH1 of neu*neu | G_CICIH2 of neu*neu | G_CICIA of neu*neu
| G_CICIG of neu*neu
| G_GH of int | G_GHGo of int
| G_WWSFSF of sff*int*sfm*sfm
| G_WPSLSN of vc*int*sfm
| G_H3 of int | G_H4 of int
| G_HGo3 of int | G_HGo4 of int | G_GG4 of int
| G_H1SFSF of sff*int*sfm*sfm | G_H2SFSF of sff*int*sfm*sfm
| G_ASFSF of sff*int*sfm*sfm
| G_HSNSL of vc*int*sfm
| G_GoSFSF of sff*int*sfm*sfm
| G_GoSNSL of vc*int*sfm
| G_HSUSD of vc*sfm*sfm*int*int | G_GSUSD of vc*sfm*sfm*int*int
| G_WPSUSD of vc*sfm*sfm*int*int
| G_WZSUSD of vc*sfm*sfm*int*int
| G_WZSLSN of vc*int*sfm | G_GlGlSQSQ
| G_PPSFSF of sff
| G_ZZSFSF of sff*int*sfm*sfm | G_ZPSFSF of sff*int*sfm*sfm
| G_GlZSFSF of sff*int*sfm*sfm | G_GlPSQSQ
| G_GlWSUSD of vc*sfm*sfm*int*int
| G_GH4 of int | G_GHGo4 of int
| G_H1H2SFSF of sff*sfm*sfm*int
| G_H1H1SFSF of sff*sfm*sfm*int
| G_H2H2SFSF of sff*sfm*sfm*int
| G_HHSFSF of sff*sfm*sfm*int
| G_AASFSF of sff*sfm*sfm*int
| G_HH1SLSN of vc*sfm*int | G_HH2SLSN of vc*sfm*int
| G_HASLSN of vc*sfm*int
| G_HH1SUSD of vc*sfm*sfm*int*int
| G_HH2SUSD of vc*sfm*sfm*int*int
| G_HASUSD of vc*sfm*sfm*int*int
| G_AG0SFSF of sff*sfm*sfm*int
| G_HGSFSF of sff*sfm*sfm*int
| G_GGSFSF of sff*sfm*sfm*int
| G_G0G0SFSF of sff*sfm*sfm*int
| G_HGSNSL of vc*sfm*int | G_H1GSNSL of vc*sfm*int
| G_H2GSNSL of vc*sfm*int | G_AGSNSL of vc*sfm*int
| G_GGSNSL of vc*sfm*int
| G_HGSUSD of vc*sfm*sfm*int*int
| G_H1GSUSD of vc*sfm*sfm*int*int
| G_H2GSUSD of vc*sfm*sfm*int*int
| G_AGSUSD of vc*sfm*sfm*int*int
| G_GGSUSD of vc*sfm*sfm*int*int
| G_SN4 of int*int
| G_SN2SL2_1 of sfm*sfm*int*int | G_SN2SL2_2 of sfm*sfm*int*int
| G_SF4 of sff*sff*sfm*sfm*sfm*sfm*int*int
| G_SF4_3 of sff*sff*sfm*sfm*sfm*sfm*int*int*int
| G_SF4_4 of sff*sff*sfm*sfm*sfm*sfm*int*int*int*int
| G_SL4 of sfm*sfm*sfm*sfm*int
| G_SL4_2 of sfm*sfm*sfm*sfm*int*int
| G_SN2SQ2 of sff*sfm*sfm*int*int
| G_SL2SQ2 of sff*sfm*sfm*sfm*sfm*int*int
| G_SUSDSNSL of vc*sfm*sfm*sfm*int*int*int
| G_SU4 of sfm*sfm*sfm*sfm*int
| G_SU4_2 of sfm*sfm*sfm*sfm*int*int
| G_SD4 of sfm*sfm*sfm*sfm*int
| G_SD4_2 of sfm*sfm*sfm*sfm*int*int
| G_SU2SD2 of sfm*sfm*sfm*sfm*int*int*int*int
| G_HSF31 of higgs*int*sfm*sfm*sff*sff
| G_HSF32 of higgs*int*int*sfm*sfm*sff*sff
| G_HSF41 of higgs*int*sfm*sfm*sff*sff
| G_HSF42 of higgs*int*int*sfm*sfm*sff*sff
| G_Grav | G_Gr_Ch of char | G_Gr_Z_Neu of neu
| G_Gr_A_Neu of neu | G_Gr4_Neu of neu
| G_Gr4_A_Ch of char | G_Gr4_Z_Ch of char
| G_Grav_N | G_Grav_U of int*sfm | G_Grav_D of int*sfm
| G_Grav_L of int*sfm | G_Grav_Uc of int*sfm | G_Grav_Dc of int*sfm
| G_Grav_Lc of int*sfm | G_GravGl
| G_Gr_H_Ch of char | G_Gr_H1_Neu of neu
| G_Gr_H2_Neu of neu | G_Gr_H3_Neu of neu
| G_Gr4A_Sl of int*sfm | G_Gr4A_Slc of int*sfm
| G_Gr4A_Su of int*sfm | G_Gr4A_Suc of int*sfm
| G_Gr4A_Sd of int*sfm | G_Gr4A_Sdc of int*sfm
| G_Gr4Z_Sn | G_Gr4Z_Snc
| G_Gr4Z_Sl of int*sfm | G_Gr4Z_Slc of int*sfm
| G_Gr4Z_Su of int*sfm | G_Gr4Z_Suc of int*sfm
| G_Gr4Z_Sd of int*sfm | G_Gr4Z_Sdc of int*sfm
| G_Gr4W_Sl of int*sfm | G_Gr4W_Slc of int*sfm
| G_Gr4W_Su of int*sfm | G_Gr4W_Suc of int*sfm
| G_Gr4W_Sd of int*sfm | G_Gr4W_Sdc of int*sfm
| G_Gr4W_Sn | G_Gr4W_Snc
| G_Gr4Gl_Su of int*sfm | G_Gr4Gl_Suc of int*sfm
| G_Gr4Gl_Sd of int*sfm | G_Gr4Gl_Sdc of int*sfm
| G_Gr4_Z_H1 of neu | G_Gr4_Z_H2 of neu | G_Gr4_Z_H3 of neu
| G_Gr4_W_H of neu | G_Gr4_W_Hc of neu | G_Gr4_H_A of char
| G_Gr4_H_Z of char
let ferm_of_sff = function
| SL, g -> (L g) | SN, g -> (N g)
| SU, g -> (U g) | SD, g -> (D g)
(* \begin{subequations}
\begin{align}
\alpha_{\text{QED}} &= \frac{1}{137.0359895} \\
\sin^2\theta_w &= 0.23124
\end{align}
\end{subequations}
Here we must perhaps allow for complex input parameters. So split them
into their modulus and their phase. At first, we leave them real; the
generalization to complex parameters is obvious. *)
- module Ch = Charges.Null
- let charges _ = ()
+ module Ch = Charges.QQ
+
+ let ( // ) = Algebra.Small_Rational.make
+
+ let generation' = function
+ | 1 -> [ 1//1; 0//1; 0//1]
+ | 2 -> [ 0//1; 1//1; 0//1]
+ | 3 -> [ 0//1; 0//1; 1//1]
+ | -1 -> [-1//1; 0//1; 0//1]
+ | -2 -> [ 0//1; -1//1; 0//1]
+ | -3 -> [ 0//1; 0//1; -1//1]
+ | n -> invalid_arg ("MSSM.generation': " ^ string_of_int n)
+
+ let generation f =
+ if Flags.ckm_present then
+ []
+ else
+ match f with
+ | L n | N n | U n | D n | Sup (_,n)
+ | Sdown (_,n) | Slepton (_,n)
+ | Sneutrino n -> generation' n
+ | _ -> [0//1; 0//1; 0//1]
+
+ let charge = function
+ | L n -> if n > 0 then -1//1 else 1//1
+ | Slepton (_,n) -> if n > 0 then -1//1 else 1//1
+ | N n -> 0//1
+ | Sneutrino n -> 0//1
+ | U n -> if n > 0 then 2//3 else -2//3
+ | Sup (_,n) -> if n > 0 then 2//3 else -2//3
+ | D n -> if n > 0 then -1//3 else 1//3
+ | Sdown (_,n) -> if n > 0 then -1//3 else 1//3
+ | Gl | Ga | Z | Neutralino _ | Gluino -> 0//1
+ | Wp -> 1//1
+ | Wm -> -1//1
+ | H_Heavy | H_Light | Phi0 -> 0//1
+ | Hp | Phip -> 1//1
+ | Hm | Phim -> -1//1
+ | Chargino (C1 | C2) -> 1//1
+ | Chargino (C1c | C2c) -> -1//1
+ | _ -> 0//1
+
+ let lepton = function
+ | L n | N n -> if n > 0 then 1//1 else -1//1
+ | Slepton (_,n)
+ | Sneutrino n -> if n > 0 then 1//1 else -1//1
+ | _ -> 0//1
+
+ let baryon = function
+ | U n | D n -> if n > 0 then 1//1 else -1//1
+ | Sup (_,n) | Sdown (_,n) -> if n > 0 then 1//1 else -1//1
+ | _ -> 0//1
+
+ let charges f =
+ [ charge f; lepton f; baryon f] @ generation f
let parameters () =
{ input = [];
derived = [];
derived_arrays = [] }
module F = Modeltools.Fusions (struct
type f = flavor
type c = constant
let compare = compare
let conjugate = conjugate
end)
(* For the couplings there are generally two possibilities concerning the
sign of the covariant derivative.
\begin{equation}
{\rm CD}^\pm = \partial_\mu \pm \ii g T^a A^a_\mu
\end{equation}
The particle data group defines the signs consistently to be positive.
Since the convention for that signs also influence the phase definitions
of the gaugino/higgsino fields via the off-diagonal entries in their
mass matrices it would be the best to adopt that convention. *)
(*** REVISED: Compatible with CD+. ***)
let electromagnetic_currents_3 g =
[((U (-g), Ga, U g), FBF (1, Psibar, V, Psi), Q_up);
((D (-g), Ga, D g), FBF (1, Psibar, V, Psi), Q_down);
((L (-g), Ga, L g), FBF (1, Psibar, V, Psi), Q_lepton) ]
(*** REVISED: Compatible with CD+. ***)
let electromagnetic_sfermion_currents g m =
[ ((Ga, Slepton (m,-g), Slepton (m,g)), Vector_Scalar_Scalar 1, Q_lepton);
((Ga, Sup (m,-g), Sup (m,g)), Vector_Scalar_Scalar 1, Q_up);
((Ga, Sdown (m,-g), Sdown (m,g)), Vector_Scalar_Scalar 1, Q_down) ]
(*** REVISED: Compatible with CD+. ***)
let electromagnetic_currents_2 c =
let cc = conj_char c in
[ ((Chargino cc, Ga, Chargino c), FBF (1, Psibar, V, Psi), Q_charg) ]
(*** REVISED: Compatible with CD+. ***)
let neutral_currents g =
[ ((L (-g), Z, L g), FBF (1, Psibar, VA, Psi), G_NC_lepton);
((N (-g), Z, N g), FBF (1, Psibar, VA, Psi), G_NC_neutrino);
((U (-g), Z, U g), FBF (1, Psibar, VA, Psi), G_NC_up);
((D (-g), Z, D g), FBF (1, Psibar, VA, Psi), G_NC_down) ]
(* \begin{equation}
\mathcal{L}_{\textrm{CC}} =
\mp \frac{g}{2\sqrt2} \sum_i \bar\psi_i \gamma^\mu
(1-\gamma_5)(T^+W^+_\mu+T^-W^-_\mu)\psi_i ,
\end{equation}
where the sign corresponds to $\text{CD}_\pm$, respectively. *)
(*** REVISED: Compatible with CD+. ***)
(* Remark: The definition with the other sign compared to the SM files
comes from the fact that $g_{cc} = 1/(2\sqrt{2})$ is used
overwhelmingly often in the SUSY Feynman rules, so that JR
decided to use a different definiton for [g_cc] in SM and MSSM. *)
let charged_currents g =
[ ((L (-g), Wm, N g), FBF ((-1), Psibar, VL, Psi), G_CC);
((N (-g), Wp, L g), FBF ((-1), Psibar, VL, Psi), G_CC) ]
(* The quark with the inverted generation (the antiparticle) is the outgoing
one, the other the incoming. The vertex attached to the outgoing up-quark
contains the CKM matrix element {\em not} complex conjugated, while the
vertex with the outgoing down-quark has the conjugated CKM matrix
element. *)
(*** REVISED: Compatible with CD+. ***)
let charged_quark_currents g h =
[ ((D (-g), Wm, U h), FBF ((-1), Psibar, VL, Psi), G_CCQ (true,g,h));
((U (-g), Wp, D h), FBF ((-1), Psibar, VL, Psi), G_CCQ (false,h,g))]
(*** REVISED: Compatible with CD+. ***)
let charged_chargino_currents n c =
let cc = conj_char c in
[ ((Chargino cc, Wp, Neutralino n),
FBF (1, Psibar, VLR, Chi), G_CWN (c,n));
((Neutralino n, Wm, Chargino c),
FBF (1, Chibar, VLR, Psi), G_NWC (n,c)) ]
(*** REVISED: Compatible with CD+. ***)
let charged_slepton_currents g m =
[ ((Wm, Slepton (m,-g), Sneutrino g), Vector_Scalar_Scalar (-1), G_SLSNW
(true,g,m));
((Wp, Slepton (m,g), Sneutrino (-g)), Vector_Scalar_Scalar 1, G_SLSNW
(false,g,m)) ]
(*** REVISED: Compatible with CD+. ***)
let charged_squark_currents' g h m1 m2 =
[ ((Wm, Sup (m1,g), Sdown (m2,-h)), Vector_Scalar_Scalar (-1), G_SWS
(true,g,h,m1,m2));
((Wp, Sup (m1,-g), Sdown (m2,h)), Vector_Scalar_Scalar 1, G_SWS
(false,g,h,m1,m2)) ]
let charged_squark_currents g h = List.flatten (Product.list2
(charged_squark_currents' g h) [M1;M2] [M1;M2])
(*** REVISED: Compatible with CD+. ***)
let neutral_sfermion_currents' g m1 m2 =
[ ((Z, Slepton (m1,-g), Slepton (m2,g)), Vector_Scalar_Scalar (-1), G_ZSF
(SL,g,m1,m2));
((Z, Sup (m1,-g), Sup (m2,g)), Vector_Scalar_Scalar (-1), G_ZSF
(SU,g,m1,m2));
((Z, Sdown (m1,-g), Sdown (m2,g)), Vector_Scalar_Scalar (-1), G_ZSF
(SD,g,m1,m2)) ]
let neutral_sfermion_currents g =
List.flatten (Product.list2 (neutral_sfermion_currents'
g) [M1;M2] [M1;M2]) @
[ ((Z, Sneutrino (-g), Sneutrino g), Vector_Scalar_Scalar (-1), G_ZSF
(SN,g,M1,M1)) ]
(* The reality of the coupling of the Z-boson to two identical neutralinos
makes the vector part of the coupling vanish. So we distinguish them not
by the name but by the structure of the couplings. *)
(*** REVISED: Compatible with CD+. ***)
let neutral_Z_1 (n,m) =
[ ((Neutralino n, Z, Neutralino m), FBF (1, Chibar, VA, Chi),
(G_NZN (n,m))) ]
(*** REVISED: Compatible with CD+. ***)
let neutral_Z_2 n =
[ ((Neutralino n, Z, Neutralino n), FBF (1, Chibar, Coupling.A, Chi),
(G_NZN (n,n)) )]
(*** REVISED: Compatible with CD+. ***)
let charged_Z c1 c2 =
let cc1 = conj_char c1 in
((Chargino cc1, Z, Chargino c2), FBF ((-1), Psibar, VA, Psi),
G_CZC (c1,c2))
(*** REVISED: Compatible with CD+. ***)
let yukawa_v =
[ ((Gluino, Gl, Gluino), FBF (1, Chibar, V, Chi), Gs) ]
(*** REVISED: Independent of the sign of CD. ***)
let yukawa_higgs g =
[ ((N (-g), Hp, L g), FBF (1, Psibar, Coupling.SR, Psi), G_YUK (6,g));
((L (-g), Hm, N g), FBF (1, Psibar, Coupling.SL, Psi), G_YUK (6,g));
((L (-g), H_Heavy, L g), FBF (1, Psibar, S, Psi), G_YUK (7,g));
((L (-g), H_Light, L g), FBF (1, Psibar, S, Psi), G_YUK (8,g));
((L (-g), A, L g), FBF (1, Psibar, P, Psi), G_YUK (9,g));
((U (-g), H_Heavy, U g), FBF (1, Psibar, S, Psi), G_YUK (10,g));
((U (-g), H_Light, U g), FBF (1, Psibar, S, Psi), G_YUK (11,g));
((U (-g), A, U g), FBF (1, Psibar, P, Psi), G_YUK (12,g));
((D (-g), H_Heavy, D g), FBF (1, Psibar, S, Psi), G_YUK (13,g));
((D (-g), H_Light, D g), FBF (1, Psibar, S, Psi), G_YUK (14,g));
((D (-g), A, D g), FBF (1, Psibar, P, Psi), G_YUK (15,g)) ]
(*** REVISED: Compatible with CD+ and GS+. ***)
let yukawa_goldstone g =
[ ((N (-g), Phip, L g), FBF (1, Psibar, Coupling.SR, Psi), G_YUK (19,g));
((L (-g), Phim, N g), FBF (1, Psibar, Coupling.SL, Psi), G_YUK (19,g));
((L (-g), Phi0, L g), FBF (1, Psibar, P, Psi), G_YUK (16,g));
((U (-g), Phi0, U g), FBF (1, Psibar, P, Psi), G_YUK (17,g));
((D (-g), Phi0, D g), FBF (1, Psibar, P, Psi), G_YUK (18,g)) ]
(*** REVISED: Independent of the sign of CD. ***)
let yukawa_higgs_quark (g,h) =
[ ((U (-g), Hp, D h), FBF (1, Psibar, SLR, Psi), G_YUK_1 (g, h));
((D (-h), Hm, U g), FBF (1, Psibar, SLR, Psi), G_YUK_2 (g, h)) ]
(*** REVISED: Compatible with CD+ and GS+. ***)
let yukawa_goldstone_quark g h =
[ ((U (-g), Phip, D h), FBF (1, Psibar, SLR, Psi), G_YUK_3 (g, h));
((D (-h), Phim, U g), FBF (1, Psibar, SLR, Psi), G_YUK_4 (g, h)) ]
(*** REVISED: Compatible with CD+. *)
let yukawa_higgs_2' (c1,c2) =
let cc1 = conj_char c1 in
[ ((Chargino cc1, H_Heavy, Chargino c2), FBF (1, Psibar, SLR, Psi),
G_CH2C (c1,c2));
((Chargino cc1, H_Light, Chargino c2), FBF (1, Psibar, SLR, Psi),
G_CH1C (c1,c2));
((Chargino cc1, A, Chargino c2), FBF (1, Psibar, SLR, Psi),
G_CAC (c1,c2)) ]
let yukawa_higgs_2'' c =
let cc = conj_char c in
[ ((Chargino cc, H_Heavy, Chargino c), FBF (1, Psibar, S, Psi),
G_CH2C (c,c));
((Chargino cc, H_Light, Chargino c), FBF (1, Psibar, S, Psi),
G_CH1C (c,c));
((Chargino cc, A, Chargino c), FBF (1, Psibar, P, Psi),
G_CAC (c,c)) ]
let yukawa_higgs_2 =
ThoList.flatmap yukawa_higgs_2' [(C1,C2);(C2,C1)] @
ThoList.flatmap yukawa_higgs_2'' [C1;C2]
(*** REVISED: Compatible with CD+ and GS+. ***)
let yukawa_goldstone_2' (c1,c2) =
let cc1 = conj_char c1 in
[ ((Chargino cc1, Phi0, Chargino c2), FBF (1, Psibar, SLR, Psi),
G_CGC (c1,c2)) ]
let yukawa_goldstone_2'' c =
let cc = conj_char c in
[ ((Chargino cc, Phi0, Chargino c), FBF (1, Psibar, P, Psi),
G_CGC (c,c)) ]
let yukawa_goldstone_2 =
ThoList.flatmap yukawa_goldstone_2' [(C1,C2);(C2,C1)] @
ThoList.flatmap yukawa_goldstone_2'' [C1;C2]
(*** REVISED: Compatible with CD+. ***)
let higgs_charg_neutr n c =
let cc = conj_char c in
[ ((Neutralino n, Hm, Chargino c), FBF (-1, Chibar, SLR, Psi),
G_NHC (n,c));
((Chargino cc, Hp, Neutralino n), FBF (-1, Psibar, SLR, Chi),
G_CHN (c,n)) ]
(*** REVISED: Compatible with CD+ and GS+. ***)
let goldstone_charg_neutr n c =
let cc = conj_char c in
[ ((Neutralino n, Phim, Chargino c), FBF (1, Chibar, SLR, Psi),
G_NGC (n,c));
((Chargino cc, Phip, Neutralino n), FBF (1, Psibar, SLR, Chi),
G_CGN (c,n)) ]
(*** REVISED: Compatible with CD+. ***)
let higgs_neutr' (n,m) =
[ ((Neutralino n, H_Heavy, Neutralino m), FBF (1, Chibar, SP, Chi),
G_CICIH2 (n,m));
((Neutralino n, H_Light, Neutralino m), FBF (1, Chibar, SP, Chi),
G_CICIH1 (n,m));
((Neutralino n, A, Neutralino m), FBF (1, Chibar, SP, Chi),
G_CICIA (n,m)) ]
let higgs_neutr'' n =
[ ((Neutralino n, H_Heavy, Neutralino n), FBF (1, Chibar, S, Chi),
G_CICIH2 (n,n));
((Neutralino n, H_Light, Neutralino n), FBF (1, Chibar, S, Chi),
G_CICIH1 (n,n));
((Neutralino n, A, Neutralino n), FBF (1, Chibar, P, Chi),
G_CICIA (n,n)) ]
let higgs_neutr =
ThoList.flatmap higgs_neutr' [(N1,N2);(N1,N3);(N1,N4);
(N2,N3);(N2,N4);(N3,N4)] @
ThoList.flatmap higgs_neutr'' [N1;N2;N3;N4]
(*** REVISED: Compatible with CD+ and GS+. ***)
let goldstone_neutr' (n,m) =
[ ((Neutralino n, Phi0, Neutralino m), FBF (1, Chibar, SP, Chi),
G_CICIG (n,m)) ]
let goldstone_neutr'' n =
[ ((Neutralino n, Phi0, Neutralino n), FBF (1, Chibar, P, Chi),
G_CICIG (n,n)) ]
let goldstone_neutr =
ThoList.flatmap goldstone_neutr' [(N1,N2);(N1,N3);(N1,N4);
(N2,N3);(N2,N4);(N3,N4)] @
ThoList.flatmap goldstone_neutr'' [N1;N2;N3;N4]
(*** REVISED: Compatible with CD+. ***)
let yukawa_n_1 n g =
[ ((Neutralino n, Slepton (M1,-g), L g), FBF (1, Chibar, Coupling.SL,
Psi), G_YUK_N (true,g,n,SL,M1));
((Neutralino n, Slepton (M2,-g), L g), FBF (1, Chibar, SR, Psi),
G_YUK_N (true,g,n,SL,M2));
((L (-g), Slepton (M1,g), Neutralino n), FBF (1, Psibar, SR, Chi),
G_YUK_N (false,g,n,SL,M1));
((L (-g), Slepton (M2,g), Neutralino n), FBF (1, Psibar, Coupling.SL,
Chi), G_YUK_N (false,g,n,SL,M2));
((Neutralino n, Sup (M1,-g), U g), FBF (1, Chibar, Coupling.SL,
Psi), G_YUK_N (true,g,n,SU,M1));
((Neutralino n, Sup (M2,-g), U g), FBF (1, Chibar, SR, Psi),
G_YUK_N (true,g,n,SU,M2));
((U (-g), Sup (M1,g), Neutralino n), FBF (1, Psibar, SR, Chi),
G_YUK_N (false,g,n,SU,M1));
((U (-g), Sup (M2,g), Neutralino n), FBF (1, Psibar, Coupling.SL,
Chi), G_YUK_N (false,g,n,SU,M2));
((Neutralino n, Sdown (M1,-g), D g), FBF (1, Chibar, Coupling.SL,
Psi), G_YUK_N (true,g,n,SD,M1));
((Neutralino n, Sdown (M2,-g), D g), FBF (1, Chibar, SR, Psi),
G_YUK_N (true,g,n,SD,M2));
((D (-g), Sdown (M1,g), Neutralino n), FBF (1, Psibar, SR, Chi),
G_YUK_N (false,g,n,SD,M1));
((D (-g), Sdown (M2,g), Neutralino n), FBF (1, Psibar, Coupling.SL,
Chi), G_YUK_N (false,g,n,SD,M2)) ]
let yukawa_n_2 n m =
[ ((Neutralino n, Slepton (m,-3), L 3), FBF (1, Chibar, SLR, Psi),
G_YUK_N (true,3,n,SL,m));
((L (-3), Slepton (m,3), Neutralino n), FBF (1, Psibar, SLR, Chi),
G_YUK_N (false,3,n,SL,m));
((Neutralino n, Sup (m,-3), U 3), FBF (1, Chibar, SLR, Psi),
G_YUK_N (true,3,n,SU,m));
((U (-3), Sup (m,3), Neutralino n), FBF (1, Psibar, SLR, Chi),
G_YUK_N (false,3,n,SU,m));
((Neutralino n, Sdown (m,-3), D 3), FBF (1, Chibar, SLR, Psi),
G_YUK_N (true,3,n,SD,m));
((D (-3), Sdown (m,3), Neutralino n), FBF (1, Psibar, SLR, Chi),
G_YUK_N (false,3,n,SD,m)) ]
let yukawa_n_3 n g =
[ ((Neutralino n, Sneutrino (-g), N g), FBF (1, Chibar, Coupling.SL,
Psi), G_YUK_N (true,g,n,SN,M1));
((N (-g), Sneutrino g, Neutralino n), FBF (1, Psibar, SR, Chi),
G_YUK_N (false,g,n,SN,M1)) ]
let yukawa_n_4 g =
[ ((U (-g), Sup (M1,g), Gluino), FBF ((-1), Psibar, SR, Chi), G_S_Sqrt);
((D (-g), Sdown (M1,g), Gluino), FBF ((-1), Psibar, SR, Chi), G_S_Sqrt);
((Gluino, Sup (M1,-g), U g), FBF ((-1), Chibar, Coupling.SL, Psi), G_S_Sqrt);
((Gluino, Sdown (M1,-g), D g), FBF ((-1), Chibar, Coupling.SL, Psi), G_S_Sqrt);
((U (-g), Sup (M2,g), Gluino), FBF (1, Psibar, Coupling.SL, Chi), G_S_Sqrt);
((D (-g), Sdown (M2,g), Gluino), FBF (1, Psibar, Coupling.SL, Chi), G_S_Sqrt);
((Gluino, Sup (M2,-g), U g), FBF (1, Chibar, SR, Psi), G_S_Sqrt);
((Gluino, Sdown (M2,-g), D g), FBF (1, Chibar, SR, Psi), G_S_Sqrt)]
let yukawa_n_5 m =
[ ((U (-3), Sup (m,3), Gluino), FBF (1, Psibar, SLR, Chi),
G_YUK_G (false,3,SU,m));
((D (-3), Sdown (m,3), Gluino), FBF (1, Psibar, SLR, Chi),
G_YUK_G (false,3,SD,m));
((Gluino, Sup (m,-3), U 3), FBF (1, Chibar, SLR, Psi),
G_YUK_G (true,3,SU,m));
((Gluino, Sdown (m,-3), D 3), FBF (1, Chibar, SLR, Psi),
G_YUK_G (true,3,SD,m))]
let yukawa_n =
List.flatten (Product.list2 yukawa_n_1 [N1;N2;N3;N4] [1;2]) @
List.flatten (Product.list2 yukawa_n_2 [N1;N2;N3;N4] [M1;M2]) @
List.flatten (Product.list2 yukawa_n_3 [N1;N2;N3;N4] [1;2;3]) @
ThoList.flatmap yukawa_n_4 [1;2] @
ThoList.flatmap yukawa_n_5 [M1;M2]
(*** REVISED: Compatible with CD+. ***)
let yukawa_c_1 c g =
let cc = conj_char c in
[ ((L (-g), Sneutrino g, Chargino cc), BBB (1, Psibar, Coupling.SR,
Psibar), G_YUK_C (true,g,c,SN,M1));
((Chargino c, Sneutrino (-g), L g), PBP (1, Psi, Coupling.SL, Psi),
G_YUK_C (false,g,c,SN,M1)) ]
let yukawa_c_2 c =
let cc = conj_char c in
[ ((L (-3), Sneutrino 3, Chargino cc), BBB (1, Psibar, SLR,
Psibar), G_YUK_C (true,3,c,SN,M1));
((Chargino c, Sneutrino (-3), L 3), PBP (1, Psi, SLR, Psi),
G_YUK_C (false,3,c,SN,M1)) ]
let yukawa_c_3 c m g =
let cc = conj_char c in
[ ((N (-g), Slepton (m,g), Chargino c), FBF (1, Psibar, Coupling.SR,
Psi), G_YUK_C (true,g,c,SL,m));
((Chargino cc, Slepton (m,-g), N g), FBF (1, Psibar, Coupling.SL,
Psi), G_YUK_C (false,g,c,SL,m)) ]
let yukawa_c c =
ThoList.flatmap (yukawa_c_1 c) [1;2] @
yukawa_c_2 c @
List.flatten (Product.list2 (yukawa_c_3 c) [M1] [1;2]) @
List.flatten (Product.list2 (yukawa_c_3 c) [M1;M2] [3])
(*** REVISED: Compatible with CD+. ***)
let yukawa_cq' c (g,h) m =
let cc = conj_char c in
[ ((Chargino c, Sup (m,-g), D h), PBP (1, Psi, SLR, Psi),
G_YUK_Q (false,g,h,c,SU,m));
((D (-h), Sup (m,g), Chargino cc), BBB (1, Psibar, SLR, Psibar),
G_YUK_Q (true,g,h,c,SU,m));
((Chargino cc, Sdown (m,-h), U g), FBF (1, Psibar, SLR, Psi),
G_YUK_Q (true,g,h,c,SD,m));
((U (-g), Sdown (m,h), Chargino c), FBF (1, Psibar, SLR, Psi),
G_YUK_Q (false,g,h,c,SD,m)) ]
let yukawa_cq'' c (g,h) =
let cc = conj_char c in
[ ((Chargino c, Sup (M1,-g), D h), PBP (1, Psi, Coupling.SL, Psi),
G_YUK_Q (false,g,h,c,SU,M1));
((D (-h), Sup (M1,g), Chargino cc),
BBB (1, Psibar, Coupling.SR, Psibar), G_YUK_Q (true,g,h,c,SU,M1));
((Chargino cc, Sdown (M1,-h), U g),
FBF (1, Psibar, Coupling.SL, Psi), G_YUK_Q (true,g,h,c,SD,M1));
((U (-g), Sdown (M1,h), Chargino c),
FBF (1, Psibar, Coupling.SR, Psi), G_YUK_Q (false,g,h,c,SD,M1)) ]
let yukawa_cq c =
if Flags.ckm_present then
List.flatten (Product.list2 (yukawa_cq' c) [(1,3);(2,3);(3,3);
(3,2);(3,1)] [M1;M2]) @
ThoList.flatmap (yukawa_cq'' c) [(1,1);(1,2);(2,1);(2,2)]
else
ThoList.flatmap (yukawa_cq' c (3,3)) [M1;M2] @
ThoList.flatmap (yukawa_cq'' c) [(1,1);(2,2)]
(*** REVISED: Compatible with CD+.
Remark: Singlet and octet gluon exchange. The coupling is divided by
sqrt(2) to account for the correct normalization of the Lie algebra
generators.
***)
let col_currents g =
[ ((D (-g), Gl, D g), FBF ((-1), Psibar, V, Psi), Gs);
((U (-g), Gl, U g), FBF ((-1), Psibar, V, Psi), Gs)]
(*** REVISED: Compatible with CD+.
Remark: Singlet and octet gluon exchange. The coupling is divided by
sqrt(2) to account for the correct normalization of the Lie algebra
generators.
***)
let col_sfermion_currents g m =
[ ((Gl, Sup (m,-g), Sup (m,g)), Vector_Scalar_Scalar (-1), Gs);
((Gl, Sdown (m,-g), Sdown (m,g)), Vector_Scalar_Scalar (-1), Gs)]
(* The gravitino coupling is generically $1/(4 M_{Pl.})$ *)
(*** Triple vertices containing graivitinos. ***)
let triple_gravitino' g =
[ ((Grino, Sneutrino (-g), N g), GBG (1, Gravbar, Coupling.SL, Psi), G_Grav_N);
((N (-g), Sneutrino g, Grino), GBG (1, Psibar, Coupling.SL, Grav), G_Grav_N)]
let triple_gravitino'' g m =
[ ((Grino, Slepton (m, -g), L g), GBG (1, Gravbar, SLR, Psi), G_Grav_L (g,m));
((L (-g), Slepton (m, g), Grino), GBG (1, Psibar, SLR, Grav), G_Grav_Lc (g,m));
((Grino, Sup (m, -g), U g), GBG (1, Gravbar, SLR, Psi), G_Grav_U (g,m));
((U (-g), Sup (m, g), Grino), GBG (1, Psibar, SLR, Grav), G_Grav_Uc (g,m));
((Grino, Sdown (m, -g), D g), GBG (1, Gravbar, SLR, Psi), G_Grav_D (g,m));
((D (-g), Sdown (m, g), Grino), GBG (1, Psibar, SLR, Grav), G_Grav_Dc (g,m)) ]
let higgs_ch_gravitino c =
let cc = conj_char c in
[ ((Grino, Hm, Chargino c), GBG (1, Gravbar, SLR, Psi), G_Gr_H_Ch c);
((Chargino cc, Hp, Grino), GBG (1, Psibar, SLR, Grav), G_Gr_H_Ch cc) ]
let higgs_neu_gravitino n =
[ ((Grino, H_Light, Neutralino n), GBG (1, Gravbar, SLR, Chi), G_Gr_H1_Neu n);
((Grino, H_Heavy, Neutralino n), GBG (1, Gravbar, SLR, Chi), G_Gr_H2_Neu n);
((Grino, A, Neutralino n), GBG (1, Gravbar, SLR, Chi), G_Gr_H3_Neu n) ]
let gravitino_gaugino_3 =
[ ((Grino, Gl, Gluino), GBG (1, Gravbar, V, Chi), G_Grav);
((Gluino, Gl, Grino), GBG (1, Chibar, V, Grav), G_Grav);
((Chargino C1c, Wp, Grino), GBG (1, Psibar, VLR, Grav), G_Gr_Ch C1);
((Chargino C2c, Wp, Grino), GBG (1, Psibar, VLR, Grav), G_Gr_Ch C2);
((Grino, Wm, Chargino C1), GBG (1, Gravbar, VLR, Psi), G_Gr_Ch C1c);
((Grino, Wm, Chargino C2), GBG (1, Gravbar, VLR, Psi), G_Gr_Ch C2c);
((Grino, Z, Neutralino N1), GBG (1, Gravbar, VLR, Chi), G_Gr_Z_Neu N1);
((Grino, Z, Neutralino N2), GBG (1, Gravbar, VLR, Chi), G_Gr_Z_Neu N2);
((Grino, Z, Neutralino N3), GBG (1, Gravbar, VLR, Chi), G_Gr_Z_Neu N3);
((Grino, Z, Neutralino N4), GBG (1, Gravbar, VLR, Chi), G_Gr_Z_Neu N4);
((Grino, Ga, Neutralino N1), GBG (1, Gravbar, VLR, Chi), G_Gr_A_Neu N1);
((Grino, Ga, Neutralino N2), GBG (1, Gravbar, VLR, Chi), G_Gr_A_Neu N2);
((Grino, Ga, Neutralino N3), GBG (1, Gravbar, VLR, Chi), G_Gr_A_Neu N3);
((Grino, Ga, Neutralino N4), GBG (1, Gravbar, VLR, Chi), G_Gr_A_Neu N4) ]
let triple_gravitino =
ThoList.flatmap triple_gravitino' [1;2;3] @
List.flatten (Product.list2 triple_gravitino'' [1;2;3] [M1; M2]) @
ThoList.flatmap higgs_ch_gravitino [C1; C2] @
ThoList.flatmap higgs_neu_gravitino [N1; N2; N3; N4] @
gravitino_gaugino_3
(*** REVISED: Compatible with CD+. ***)
let triple_gauge =
[ ((Ga, Wm, Wp), Gauge_Gauge_Gauge 1, I_Q_W);
((Z, Wm, Wp), Gauge_Gauge_Gauge 1, I_G_ZWW);
((Gl, Gl, Gl), Gauge_Gauge_Gauge 1, I_G_S)]
(*** REVISED: Independent of the sign of CD. ***)
let gauge4 = Vector4 [(2, C_13_42); (-1, C_12_34); (-1, C_14_23)]
let gluon4 = Vector4 [(-1, C_13_42); (-1, C_12_34); (-1, C_14_23)]
let minus_gauge4 = Vector4 [(-2, C_13_42); (1, C_12_34); (1, C_14_23)]
let quartic_gauge =
[ (Wm, Wp, Wm, Wp), gauge4, G_WWWW;
(Wm, Z, Wp, Z), minus_gauge4, G_ZZWW;
(Wm, Z, Wp, Ga), minus_gauge4, G_PZWW;
(Wm, Ga, Wp, Ga), minus_gauge4, G_PPWW;
(Gl, Gl, Gl, Gl), gauge4, G_SS]
(* The [Scalar_Vector_Vector] couplings do not depend on the choice of the
sign of the covariant derivative since they are quadratic in the
gauge couplings. *)
(*** REVISED: Compatible with CD+. ***)
(*** Revision: 2005-03-10: first two vertices corrected. ***)
let gauge_higgs =
[ ((Wm, Hp, A), Vector_Scalar_Scalar 1, G_GH 1);
((Wp, Hm, A), Vector_Scalar_Scalar 1, G_GH 1);
((Z, H_Heavy, A), Vector_Scalar_Scalar 1, G_GH 3);
((Z, H_Light, A), Vector_Scalar_Scalar 1, G_GH 2);
((H_Heavy, Wp, Wm), Scalar_Vector_Vector 1, G_GH 5);
((H_Light, Wp, Wm), Scalar_Vector_Vector 1, G_GH 4);
((Wm, Hp, H_Heavy), Vector_Scalar_Scalar 1, G_GH 7);
((Wp, Hm, H_Heavy), Vector_Scalar_Scalar (-1), G_GH 7);
((Wm, Hp, H_Light), Vector_Scalar_Scalar 1, G_GH 6);
((Wp, Hm, H_Light), Vector_Scalar_Scalar (-1), G_GH 6);
((H_Heavy, Z, Z), Scalar_Vector_Vector 1, G_GH 9);
((H_Light, Z, Z), Scalar_Vector_Vector 1, G_GH 8);
((Z, Hp, Hm), Vector_Scalar_Scalar 1, G_GH 10);
((Ga, Hp, Hm), Vector_Scalar_Scalar 1, G_GH 11) ]
(*** REVISED: Compatible with CD+ and GS+. ***)
let gauge_higgs_gold =
[ ((Wp, Phi0, Phim), Vector_Scalar_Scalar 1, G_GH 1);
((Wm, Phi0, Phip), Vector_Scalar_Scalar 1, G_GH 1);
((Z, H_Heavy, Phi0), Vector_Scalar_Scalar 1, G_GH 2);
((Z, H_Light, Phi0), Vector_Scalar_Scalar (-1), G_GH 3);
((Wp, H_Heavy, Phim), Vector_Scalar_Scalar 1, G_GH 6);
((Wm, H_Heavy, Phip), Vector_Scalar_Scalar (-1), G_GH 6);
((Wp, H_Light, Phim), Vector_Scalar_Scalar (-1), G_GH 7);
((Wm, H_Light, Phip), Vector_Scalar_Scalar 1, G_GH 7);
((Phim, Wp, Ga), Scalar_Vector_Vector 1, G_GHGo 1);
((Phip, Wm, Ga), Scalar_Vector_Vector 1, G_GHGo 1);
((Phim, Wp, Z), Scalar_Vector_Vector 1, G_GHGo 2);
((Phip, Wm, Z), Scalar_Vector_Vector 1, G_GHGo 2);
((Z, Phip, Phim), Vector_Scalar_Scalar 1, G_GH 10);
((Ga, Phip, Phim), Vector_Scalar_Scalar 1, G_GH 11) ]
let gauge_higgs4 =
[ ((A, A, Z, Z), Scalar2_Vector2 1, G_GH4 1);
((H_Heavy, H_Heavy, Z, Z), Scalar2_Vector2 1, G_GH4 3);
((H_Light, H_Light, Z, Z), Scalar2_Vector2 1, G_GH4 2);
((Hp, Hm, Z, Z), Scalar2_Vector2 1, G_GH4 4);
((Hp, Hm, Ga, Ga), Scalar2_Vector2 1, G_GH4 5);
((Hp, Hm, Ga, Z), Scalar2_Vector2 1, G_GH4 6);
((Hp, H_Heavy, Wm, Z), Scalar2_Vector2 1, G_GH4 8);
((Hm, H_Heavy, Wp, Z), Scalar2_Vector2 1, G_GH4 8);
((Hp, H_Light, Wm, Z), Scalar2_Vector2 1, G_GH4 7);
((Hm, H_Light, Wp, Z), Scalar2_Vector2 1, G_GH4 7);
((Hp, H_Heavy, Wm, Ga), Scalar2_Vector2 1, G_GH4 10);
((Hm, H_Heavy, Wp, Ga), Scalar2_Vector2 1, G_GH4 10);
((Hp, H_Light, Wm, Ga), Scalar2_Vector2 1, G_GH4 9);
((Hm, H_Light, Wp, Ga), Scalar2_Vector2 1, G_GH4 9);
((A, A, Wp, Wm), Scalar2_Vector2 1, G_GH4 11);
((H_Heavy, H_Heavy, Wp, Wm), Scalar2_Vector2 1, G_GH4 13);
((H_Light, H_Light, Wp, Wm), Scalar2_Vector2 1, G_GH4 12);
((Hp, Hm, Wp, Wm), Scalar2_Vector2 1, G_GH4 14);
((Hp, A, Wm, Z), Scalar2_Vector2 1, G_GH4 15);
((Hm, A, Wp, Z), Scalar2_Vector2 (-1), G_GH4 15);
((Hp, A, Wm, Ga), Scalar2_Vector2 1, G_GH4 16);
((Hm, A, Wp, Ga), Scalar2_Vector2 (-1), G_GH4 16) ]
let gauge_higgs_gold4 =
[ ((Z, Z, Phi0, Phi0), Scalar2_Vector2 1, G_GHGo4 1);
((Z, Z, Phip, Phim), Scalar2_Vector2 1, G_GHGo4 2);
((Ga, Ga, Phip, Phim), Scalar2_Vector2 1, G_GHGo4 3);
((Z, Ga, Phip, Phim), Scalar2_Vector2 1, G_GHGo4 4);
((Wp, Wm, Phip, Phim), Scalar2_Vector2 1, G_GHGo4 5);
((Wp, Wm, Phi0, Phi0), Scalar2_Vector2 1, G_GHGo4 5);
((Wp, Z, Phim, Phi0), Scalar2_Vector2 1, G_GHGo4 6);
((Wm, Z, Phip, Phi0), Scalar2_Vector2 (-1), G_GHGo4 6);
((Wp, Ga, Phim, Phi0), Scalar2_Vector2 1, G_GHGo4 7);
((Wm, Ga, Phip, Phi0), Scalar2_Vector2 (-1), G_GHGo4 7);
((Wp, Z, Phim, H_Heavy), Scalar2_Vector2 1, G_GHGo4 9);
((Wm, Z, Phip, H_Heavy), Scalar2_Vector2 1, G_GHGo4 9);
((Wp, Ga, Phim, H_Heavy), Scalar2_Vector2 1, G_GHGo4 11);
((Wm, Ga, Phip, H_Heavy), Scalar2_Vector2 1, G_GHGo4 11);
((Wp, Z, Phim, H_Light), Scalar2_Vector2 1, G_GHGo4 8);
((Wm, Z, Phip, H_Light), Scalar2_Vector2 1, G_GHGo4 8);
((Wp, Ga, Phim, H_Light), Scalar2_Vector2 1, G_GHGo4 10);
((Wm, Ga, Phip, H_Light), Scalar2_Vector2 1, G_GHGo4 10) ]
let gauge_sfermion4' g m1 m2 =
[ ((Wp, Wm, Slepton (m1,g), Slepton (m2,-g)), Scalar2_Vector2 1,
G_WWSFSF (SL,g,m1,m2));
((Z, Ga, Slepton (m1,g), Slepton (m2,-g)), Scalar2_Vector2 1,
G_ZPSFSF (SL,g,m1,m2));
((Z, Z, Slepton (m1,g), Slepton (m2,-g)), Scalar2_Vector2 1, G_ZZSFSF
(SL,g,m1,m2));
((Wp, Wm, Sup (m1,g), Sup (m2,-g)), Scalar2_Vector2 1, G_WWSFSF
(SU,g,m1,m2));
((Wp, Wm, Sdown (m1,g), Sdown (m2,-g)), Scalar2_Vector2 1, G_WWSFSF
(SD,g,m1,m2));
((Z, Z, Sup (m1,g), Sup (m2,-g)), Scalar2_Vector2 1, G_ZZSFSF
(SU,g,m1,m2));
((Z, Z, Sdown (m1,g), Sdown (m2,-g)), Scalar2_Vector2 1, G_ZZSFSF
(SD,g,m1,m2));
((Z, Ga, Sup (m1,g), Sup (m2,-g)), Scalar2_Vector2 1, G_ZPSFSF
(SU,g,m1,m2));
((Z, Ga, Sdown (m1,g), Sdown (m2,-g)), Scalar2_Vector2 1, G_ZPSFSF
(SD,g,m1,m2)) ]
let gauge_sfermion4'' g m =
[ ((Wp, Ga, Slepton (m,g), Sneutrino (-g)), Scalar2_Vector2 1, G_WPSLSN
(false,g,m));
((Wm, Ga, Slepton (m,-g), Sneutrino g), Scalar2_Vector2 1,
G_WPSLSN (true,g,m));
((Wp, Z, Slepton (m,g), Sneutrino (-g)), Scalar2_Vector2 1, G_WZSLSN
(false,g,m));
((Wm, Z, Slepton (m,-g), Sneutrino g), Scalar2_Vector2 1,
G_WZSLSN (true,g,m));
((Ga, Ga, Slepton (m,g), Slepton (m,-g)), Scalar2_Vector2 1, G_PPSFSF SL);
((Ga, Ga, Sup (m,g), Sup (m,-g)), Scalar2_Vector2 1, G_PPSFSF SU);
((Ga, Ga, Sdown (m,g), Sdown (m,-g)), Scalar2_Vector2 1, G_PPSFSF SD)]
let gauge_sfermion4 g =
List.flatten (Product.list2 (gauge_sfermion4' g) [M1;M2] [M1;M2]) @
ThoList.flatmap (gauge_sfermion4'' g) [M1;M2] @
[ ((Wp, Wm, Sneutrino g, Sneutrino (-g)), Scalar2_Vector2 1, G_WWSFSF
(SN,g,M1,M1));
((Z, Z, Sneutrino g, Sneutrino (-g)), Scalar2_Vector2 1, G_ZZSFSF
(SN,g,M1,M1)) ]
let gauge_squark4' g h m1 m2 =
[ ((Wp, Ga, Sup (m1,-g), Sdown (m2,h)), Scalar2_Vector2 1, G_WPSUSD
(false,m1,m2,g,h));
((Wm, Ga, Sup (m1,g), Sdown (m2,-h)), Scalar2_Vector2 1, G_WPSUSD
(true,m1,m2,g,h));
((Wp, Z, Sup (m1,-g), Sdown (m2,h)), Scalar2_Vector2 1, G_WZSUSD
(false,m1,m2,g,h));
((Wm, Z, Sup (m1,g), Sdown (m2,-h)), Scalar2_Vector2 1, G_WZSUSD
(true,m1,m2,g,h)) ]
let gauge_squark4 g h = List.flatten (Product.list2 (gauge_squark4' g h)
[M1;M2] [M1;M2])
let gluon_w_squark' g h m1 m2 =
[ ((Gl, Wp, Sup (m1,-g), Sdown (m2,h)),
Scalar2_Vector2 1, G_GlWSUSD (false,m1,m2,g,h));
((Gl, Wm, Sup (m1,g), Sdown (m2,-h)),
Scalar2_Vector2 1, G_GlWSUSD (true,m1,m2,g,h)) ]
let gluon_w_squark g h =
List.flatten (Product.list2 (gluon_w_squark' g h) [M1;M2] [M1;M2])
let gluon_gauge_squark' g m1 m2 =
[ ((Gl, Z, Sup (m1,g), Sup (m2,-g)), Scalar2_Vector2 2, G_GlZSFSF (SU,g,m1,m2));
((Gl, Z, Sdown (m1,g), Sdown (m2,-g)), Scalar2_Vector2 2, G_GlZSFSF (SD,g,m1,m2)) ]
let gluon_gauge_squark'' g m =
[ ((Gl, Ga, Sup (m,g), Sup (m,-g)), Scalar2_Vector2 2, G_GlPSQSQ);
((Gl, Ga, Sdown (m,g), Sdown (m,-g)), Scalar2_Vector2 (-1), G_GlPSQSQ) ]
let gluon_gauge_squark g =
List.flatten (Product.list2 (gluon_gauge_squark' g) [M1;M2] [M1;M2]) @
ThoList.flatmap (gluon_gauge_squark'' g) [M1;M2]
let gluon2_squark2 g m =
[ ((Gl, Gl, Sup (m,g), Sup (m,-g)), Scalar2_Vector2 1, G_GlGlSQSQ);
((Gl, Gl, Sdown (m,g), Sdown (m,-g)), Scalar2_Vector2 1, G_GlGlSQSQ)]
(*** REVISED: Independent of the sign of CD. ***)
let higgs =
[ ((Hp, Hm, H_Heavy), Scalar_Scalar_Scalar 1, G_H3 1);
((Hp, Hm, H_Light), Scalar_Scalar_Scalar 1, G_H3 2);
((H_Heavy, H_Heavy, H_Light), Scalar_Scalar_Scalar 1, G_H3 3);
((H_Heavy, H_Heavy, H_Heavy), Scalar_Scalar_Scalar 1, G_H3 4);
((H_Light, H_Light, H_Light), Scalar_Scalar_Scalar 1, G_H3 5);
((H_Heavy, H_Light, H_Light), Scalar_Scalar_Scalar 1, G_H3 6);
((H_Heavy, A, A), Scalar_Scalar_Scalar 1, G_H3 7);
((H_Light, A, A), Scalar_Scalar_Scalar 1, G_H3 8) ]
(*** REVISED: Compatible with GS+, independent of the sign of CD. ***)
let higgs_gold =
[ ((H_Heavy, A, Phi0), Scalar_Scalar_Scalar 1, G_HGo3 1);
((H_Light, A, Phi0), Scalar_Scalar_Scalar 1, G_HGo3 2);
((H_Heavy, Hp, Phim), Scalar_Scalar_Scalar 1, G_HGo3 3);
((H_Heavy, Hm, Phip), Scalar_Scalar_Scalar 1, G_HGo3 3);
((H_Light, Hp, Phim), Scalar_Scalar_Scalar 1, G_HGo3 4);
((H_Light, Hm, Phip), Scalar_Scalar_Scalar 1, G_HGo3 4);
((A, Hp, Phim), Scalar_Scalar_Scalar (-1), G_HGo3 5);
((A, Hm, Phip), Scalar_Scalar_Scalar 1, G_HGo3 5);
((H_Heavy, Phi0, Phi0), Scalar_Scalar_Scalar (-1), G_H3 7);
((H_Heavy, Phip, Phim), Scalar_Scalar_Scalar (-1), G_H3 7);
((H_Light, Phi0, Phi0), Scalar_Scalar_Scalar (-1), G_H3 8);
((H_Light, Phip, Phim), Scalar_Scalar_Scalar (-1), G_H3 8) ]
(* Here follow purely scalar quartic vertices which are only available for the
no-Whizard colored version. *)
(*** REVISED: Independent of the sign of CD. ***)
let higgs4 =
[ ((Hp, Hm, Hp, Hm), Scalar4 1, G_H4 1);
((Hp, Hm, H_Heavy, H_Heavy), Scalar4 1, G_H4 2);
((Hp, Hm, H_Light, H_Light), Scalar4 1, G_H4 3);
((Hp, Hm, H_Heavy, H_Light), Scalar4 1, G_H4 4);
((Hp, Hm, A, A), Scalar4 1, G_H4 5);
((H_Heavy, H_Heavy, H_Heavy, H_Heavy), Scalar4 1, G_H4 6);
((H_Light, H_Light, H_Light, H_Light), Scalar4 1, G_H4 6);
((H_Heavy, H_Heavy, H_Light, H_Light), Scalar4 1, G_H4 7);
((H_Heavy, H_Light, H_Light, H_Light), Scalar4 1, G_H4 8);
((H_Heavy, H_Heavy, H_Heavy, H_Light), Scalar4 (-1), G_H4 8);
((H_Heavy, H_Heavy, A, A), Scalar4 1, G_H4 9);
((H_Light, H_Light, A, A), Scalar4 (-1), G_H4 9);
((H_Heavy, H_Light, A, A), Scalar4 1, G_H4 10);
((A, A, A, A), Scalar4 1, G_H4 11) ]
(*** REVISED: Compatible with GS+, independent of the sign of CD. ***)
let higgs_gold4 =
[ ((H_Heavy, H_Heavy, A, Phi0), Scalar4 1, G_HGo4 1);
((H_Heavy, H_Light, A, Phi0), Scalar4 1, G_HGo4 2);
((H_Light, H_Light, A, Phi0), Scalar4 (-1), G_HGo4 1);
((A, A, A, Phi0), Scalar4 3, G_HGo4 3);
((Hp, Hm, A, Phi0), Scalar4 1, G_HGo4 3);
((H_Heavy, H_Heavy, Hp, Phim), Scalar4 1, G_HGo4 4);
((H_Heavy, H_Heavy, Hm, Phip), Scalar4 1, G_HGo4 4);
((H_Heavy, H_Light, Hp, Phim), Scalar4 1, G_HGo4 5);
((H_Heavy, H_Light, Hm, Phip), Scalar4 1, G_HGo4 5);
((H_Light, H_Light, Hp, Phim), Scalar4 (-1), G_HGo4 4);
((H_Light, H_Light, Hm, Phip), Scalar4 (-1), G_HGo4 4);
((A, A, Hp, Phim), Scalar4 1, G_HGo4 6);
((A, A, Hm, Phip), Scalar4 1, G_HGo4 6);
((H_Heavy, A, Hp, Phim), Scalar4 1, G_HGo4 7);
((H_Heavy, A, Hm, Phip), Scalar4 (-1), G_HGo4 7);
((H_Light, A, Hp, Phim), Scalar4 1, G_HGo4 8);
((H_Light, A, Hm, Phip), Scalar4 (-1), G_HGo4 8);
((Hp, Hm, Hp, Phim), Scalar4 2, G_HGo4 6);
((Hp, Hm, Hm, Phip), Scalar4 2, G_HGo4 6);
((H_Heavy, H_Heavy, Phi0, Phi0), Scalar4 (-1), G_H4 9);
((H_Heavy, H_Light, Phi0, Phi0), Scalar4 (-1), G_H4 10);
((H_Light, H_Light, Phi0, Phi0), Scalar4 1, G_H4 9);
((A, A, Phi0, Phi0), Scalar4 1, G_HGo4 9);
((Hp, Hm, Phi0, Phi0), Scalar4 1, G_HGo4 10);
((H_Heavy, Hp, Phim, Phi0), Scalar4 1, G_HGo4 8);
((H_Heavy, Hm, Phip, Phi0), Scalar4 (-1), G_HGo4 8);
((H_Light, Hp, Phim, Phi0), Scalar4 (-1), G_HGo4 7);
((H_Light, Hm, Phip, Phi0), Scalar4 1, G_HGo4 7);
((A, Hp, Phim, Phi0), Scalar4 1, G_HGo4 11);
((A, Hm, Phip, Phi0), Scalar4 1, G_HGo4 11);
((H_Heavy, H_Heavy, Phip, Phim), Scalar4 1, G_HGo4 12);
((H_Heavy, H_Light, Phip, Phim), Scalar4 1, G_HGo4 13);
((H_Light, H_Light, Phip, Phim), Scalar4 1, G_HGo4 14);
((A, A, Phip, Phim), Scalar4 1, G_HGo4 15);
((Hp, Hm, Phip, Phim), Scalar4 1, G_HGo4 16);
((Hp, Hp, Phim, Phim), Scalar4 1, G_HGo4 17);
((Hm, Hm, Phip, Phip), Scalar4 1, G_HGo4 17);
((Hp, Phim, Phi0, Phi0), Scalar4 (-1), G_HGo4 6);
((Hm, Phip, Phi0, Phi0), Scalar4 (-1), G_HGo4 6);
((A, Phi0, Phi0, Phi0), Scalar4 (-3), G_HGo4 6);
((A, Phi0, Phip, Phim), Scalar4 (-1), G_HGo4 6);
((Hp, Phim, Phip, Phim), Scalar4 (-2), G_HGo4 6);
((Hm, Phip, Phip, Phim), Scalar4 (-2), G_HGo4 6) ]
(*** REVISED: Independent of the sign of CD and GS. ***)
let goldstone4 =
[ ((Phi0, Phi0, Phi0, Phi0), Scalar4 1, G_GG4 1);
((Phip, Phim, Phi0, Phi0), Scalar4 1, G_GG4 2);
((Phip, Phim, Phip, Phim), Scalar4 1, G_GG4 3) ]
(* The vertices of the type Higgs - Sfermion - Sfermion are independent of
the choice of the CD sign since they are quadratic in the gauge
coupling. *)
(*** REVISED: Independent of the sign of CD. ***)
let higgs_sneutrino' g =
[ ((H_Heavy, Sneutrino g, Sneutrino (-g)), Scalar_Scalar_Scalar 1,
G_H2SFSF (SN,g,M1,M1));
((H_Light, Sneutrino g, Sneutrino (-g)), Scalar_Scalar_Scalar 1,
G_H1SFSF (SN,g,M1,M1));
((Hp, Sneutrino (-g), Slepton (M1,g)), Scalar_Scalar_Scalar 1,
G_HSNSL (false,g,M1));
((Hm, Sneutrino g, Slepton (M1,-g)), Scalar_Scalar_Scalar 1,
G_HSNSL (true,g,M1)) ]
let higgs_sneutrino'' =
[ ((Hp, Sneutrino (-3), Slepton (M2,3)), Scalar_Scalar_Scalar 1,
G_HSNSL (false,3,M2));
((Hm, Sneutrino 3, Slepton (M2,-3)), Scalar_Scalar_Scalar 1,
G_HSNSL (false,3,M2)) ]
let higgs_sneutrino =
ThoList.flatmap higgs_sneutrino' [1;2;3] @ higgs_sneutrino''
(* Under the assumption that there is no mixing between the left- and
right-handed sfermions for the first two generations there is only a
coupling of the form Higgs - sfermion1 - sfermion2 for the third
generation. All the others are suppressed by $m_f/M_W$. *)
(*** REVISED: Independent of the sign of CD. ***)
let higgs_sfermion' g m1 m2 =
[ ((H_Heavy, Slepton (m1,g), Slepton (m2,-g)), Scalar_Scalar_Scalar 1,
G_H2SFSF (SL,g,m1,m2));
((H_Light, Slepton (m1,g), Slepton (m2,-g)), Scalar_Scalar_Scalar 1,
G_H1SFSF (SL,g,m1,m2));
((H_Heavy, Sup (m1,g), Sup (m2,-g)), Scalar_Scalar_Scalar 1,
G_H2SFSF (SU,g,m1,m2));
((H_Heavy, Sdown (m1,g), Sdown (m2,-g)), Scalar_Scalar_Scalar 1,
G_H2SFSF (SD,g,m1,m2));
((H_Light, Sup (m1,g), Sup (m2,-g)), Scalar_Scalar_Scalar 1,
G_H1SFSF (SU,g,m1,m2));
((H_Light, Sdown (m1,g), Sdown (m2,-g)), Scalar_Scalar_Scalar 1,
G_H1SFSF (SD,g,m1,m2)) ]
let higgs_sfermion'' m1 m2 =
[ ((A, Slepton (m1,3), Slepton (m2,-3)), Scalar_Scalar_Scalar 1,
G_ASFSF (SL,3,m1,m2));
((A, Sup (m1,3), Sup (m2,-3)), Scalar_Scalar_Scalar 1,
G_ASFSF (SU,3,m1,m2));
((A, Sdown (m1,3), Sdown (m2,-3)), Scalar_Scalar_Scalar 1,
G_ASFSF (SD,3,m1,m2)) ]
let higgs_sfermion = List.flatten (Product.list2 (higgs_sfermion' 3)
[M1;M2] [M1;M2]) @
(higgs_sfermion' 1 M1 M1) @ (higgs_sfermion' 1 M2 M2) @
(higgs_sfermion' 2 M1 M1) @ (higgs_sfermion' 2 M2 M2) @
List.flatten (Product.list2 higgs_sfermion'' [M1;M2] [M1;M2])
(*i let higgs_sfermion g = List.flatten (Product.list2 (higgs_sfermion' g)
[M1;M2] [M1;M2]) i*)
(*** REVISED: Independent of the sign of CD, compatible with GS+. ***)
let goldstone_sfermion' g m1 m2 =
[ ((Phi0, Slepton (m1,g), Slepton (m2,-g)), Scalar_Scalar_Scalar 1,
G_GoSFSF (SL,g,m1,m2));
((Phi0, Sup (m1,g), Sup (m2,-g)), Scalar_Scalar_Scalar 1,
G_GoSFSF (SU,g,m1,m2));
((Phi0, Sdown (m1,g), Sdown (m2,-g)), Scalar_Scalar_Scalar 1,
G_GoSFSF (SD,g,m1,m2))]
let goldstone_sfermion'' g =
[ ((Phip, Sneutrino (-g), Slepton (M1,g)), Scalar_Scalar_Scalar 1,
G_GoSNSL (false,g,M1));
((Phim, Sneutrino g, Slepton (M1,-g)), Scalar_Scalar_Scalar 1,
G_GoSNSL (true,g,M1)) ]
let goldstone_sfermion''' g =
[ ((Phip, Sneutrino (-g), Slepton (M2,g)), Scalar_Scalar_Scalar 1,
G_GoSNSL (false,g,M2));
((Phim, Sneutrino g, Slepton (M2,-g)), Scalar_Scalar_Scalar 1,
G_GoSNSL (true,g,M2))]
let goldstone_sfermion =
List.flatten (Product.list2 (goldstone_sfermion' 3) [M1;M2] [M1;M2]) @
ThoList.flatmap goldstone_sfermion'' [1;2;3] @
goldstone_sfermion''' 3
(*** REVISED: Independent of the sign of CD. ***)
let higgs_squark' g h m1 m2 =
[ ((Hp, Sup (m1,-g), Sdown (m2,h)), Scalar_Scalar_Scalar 1,
G_HSUSD (false,m1,m2,g,h));
((Hm, Sup (m1,g), Sdown (m2,-h)), Scalar_Scalar_Scalar 1,
G_HSUSD (true,m1,m2,g,h)) ]
let higgs_squark_a g h = higgs_squark' g h M1 M1
let higgs_squark_b (g,h) = List.flatten (Product.list2 (higgs_squark' g h)
[M1;M2] [M1;M2])
let higgs_squark =
List.flatten (Product.list2 higgs_squark_a [1;2] [1;2]) @
ThoList.flatmap higgs_squark_b [(1,3);(2,3);(3,3);(3,1);(3,2)]
(*** REVISED: Independent of the sign of CD, compatible with GS+. ***)
let goldstone_squark' g h m1 m2 =
[ ((Phip, Sup (m1,-g), Sdown (m2,h)), Scalar_Scalar_Scalar 1,
G_GSUSD (false,m1,m2,g,h));
((Phim, Sup (m1,g), Sdown (m2,-h)), Scalar_Scalar_Scalar 1,
G_GSUSD (true,m1,m2,g,h)) ]
let goldstone_squark_a g h = goldstone_squark' g h M1 M1
let goldstone_squark_b (g,h) = List.flatten (Product.list2
(goldstone_squark' g h) [M1;M2] [M1;M2])
let goldstone_squark =
List.flatten (Product.list2 goldstone_squark_a [1;2] [1;2]) @
ThoList.flatmap goldstone_squark_b [(1,3);(2,3);(3,3);(3,1);(3,2)]
(* BAUSTELLE: For the quartic scalar coupligs we does not allow [whiz_col]. *)
let higgs_sneutrino4' g m =
[ ((Hp, H_Heavy, Slepton (m,g), Sneutrino (-g)), Scalar4 1,
G_HH2SLSN (false,m,g));
((Hm, H_Heavy, Slepton (m,-g), Sneutrino g), Scalar4 1,
G_HH2SLSN (true,m,g));
((Hp, H_Light, Slepton (m,g), Sneutrino (-g)), Scalar4 1,
G_HH1SLSN (false,m,g));
((Hm, H_Light, Slepton (m,-g), Sneutrino g), Scalar4 1,
G_HH1SLSN (true,m,g));
((Hp, A, Slepton (m,g), Sneutrino (-g)), Scalar4 1,
G_HASLSN (false,m,g));
((Hm, A, Slepton (m,-g), Sneutrino g), Scalar4 1,
G_HASLSN (true,m,g)) ]
let higgs_sneutrino4 g =
ThoList.flatmap (higgs_sneutrino4' g) [M1;M2] @
[ ((H_Heavy, H_Heavy, Sneutrino g, Sneutrino (-g)), Scalar4 1,
G_H2H2SFSF (SN,M1,M1,g));
((H_Heavy, H_Light, Sneutrino g, Sneutrino (-g)), Scalar4 1,
G_H1H2SFSF (SN,M1,M1,g));
((H_Light, H_Light, Sneutrino g, Sneutrino (-g)), Scalar4 1,
G_H1H1SFSF (SN,M1,M1,g));
((Hp, Hm, Sneutrino g, Sneutrino (-g)), Scalar4 1, G_HHSFSF (SN,M1,M1,g)) ]
let higgs_sfermion4' g m1 m2 =
[ ((H_Heavy, H_Heavy, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1,
G_H2H2SFSF (SL,m1,m2,g));
((H_Heavy, H_Light, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1,
G_H1H2SFSF (SL,m1,m2,g));
((H_Light, H_Light, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1,
G_H1H1SFSF (SL,m1,m2,g));
((A, A, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1,
G_AASFSF (SL,m1,m2,g));
((Hp, Hm, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1,
G_HHSFSF (SL,m1,m2,g));
((H_Heavy, H_Heavy, Sup (m1,g), Sup (m2,-g)), Scalar4 1,
G_H2H2SFSF (SU,m1,m2,g));
((H_Heavy, H_Heavy, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1,
G_H2H2SFSF (SD,m1,m2,g));
((H_Light, H_Light, Sup (m1,g), Sup (m2,-g)), Scalar4 1,
G_H1H1SFSF (SU,m1,m2,g));
((H_Light, H_Light, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1,
G_H1H1SFSF (SD,m1,m2,g));
((H_Light, H_Heavy, Sup (m1,g), Sup (m2,-g)), Scalar4 1,
G_H1H2SFSF (SU,m1,m2,g));
((H_Light, H_Heavy, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1,
G_H1H2SFSF (SD,m1,m2,g));
((Hp, Hm, Sup (m1,g), Sup (m2,-g)), Scalar4 1, G_HHSFSF (SU,m1,m2,g));
((Hp, Hm, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1, G_HHSFSF (SD,m1,m2,g));
((A, A, Sup (m1,g), Sup (m2,-g)), Scalar4 1, G_AASFSF (SU,m1,m2,g));
((A, A, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1, G_AASFSF (SD,m1,m2,g)) ]
let higgs_sfermion4 g = List.flatten (Product.list2 (higgs_sfermion4' g)
[M1;M2] [M1;M2])
let higgs_squark4' g h m1 m2 =
[ ((Hp, H_Light, Sup (m1,-g), Sdown (m2,h)), Scalar4 1,
G_HH1SUSD (false,m1,m2,g,h));
((Hm, H_Light, Sup (m1,g), Sdown (m2,-h)), Scalar4 1,
G_HH1SUSD (true,m1,m2,g,h));
((Hp, H_Heavy, Sup (m1,-g), Sdown (m2,h)), Scalar4 1,
G_HH2SUSD (false,m1,m2,g,h));
((Hm, H_Heavy, Sup (m1,g), Sdown (m2,-h)), Scalar4 1,
G_HH2SUSD (true,m1,m2,g,h));
((Hp, A, Sup (m1,-g), Sdown (m2,h)), Scalar4 1,
G_HASUSD (false,m1,m2,g,h));
((Hm, A, Sup (m1,g), Sdown (m2,-h)), Scalar4 1,
G_HASUSD (true,m1,m2,g,h)) ]
let higgs_squark4 g h = List.flatten (Product.list2 (higgs_squark4' g h)
[M1;M2] [M1;M2])
let higgs_gold_sneutrino' g m =
[ ((Hp, Phi0, Sneutrino (-g), Slepton (m,g)), Scalar4 1, G_HGSNSL (false,m,g));
((Hm, Phi0, Sneutrino g, Slepton (m,-g)), Scalar4 1, G_HGSNSL (true,m,g));
((H_Heavy, Phip, Sneutrino (-g), Slepton (m,g)), Scalar4 1,
G_H2GSNSL (false,m,g));
((H_Heavy, Phim, Sneutrino g, Slepton (m,-g)), Scalar4 1,
G_H2GSNSL (true,m,g));
((H_Light, Phip, Sneutrino (-g), Slepton (m,g)), Scalar4 1,
G_H1GSNSL (false,m,g));
((H_Light, Phim, Sneutrino g, Slepton (m,-g)), Scalar4 1,
G_H1GSNSL (true,m,g));
((A, Phip, Sneutrino (-g), Slepton (m,g)), Scalar4 1, G_AGSNSL (false,m,g));
((A, Phim, Sneutrino g, Slepton (m,-g)), Scalar4 1, G_AGSNSL (true,m,g));
((Phi0, Phip, Sneutrino (-g), Slepton (m,g)), Scalar4 1, G_GGSNSL (false,m,g));
((Phi0, Phim, Sneutrino g, Slepton (m,-g)), Scalar4 1, G_GGSNSL (true,m,g))]
let higgs_gold_sneutrino g =
ThoList.flatmap (higgs_gold_sneutrino' g) [M1;M2] @
[ ((A, Phi0, Sneutrino g, Sneutrino (-g)), Scalar4 1,
G_AG0SFSF (SN,M1,M1,g));
((Hp, Phim, Sneutrino g, Sneutrino (-g)), Scalar4 1,
G_HGSFSF (SN,M1,M1,g));
((Hm, Phip, Sneutrino g, Sneutrino (-g)), Scalar4 1,
G_HGSFSF (SN,M1,M1,g));
((Phip, Phim, Sneutrino g, Sneutrino (-g)), Scalar4 1,
G_GGSFSF (SN,M1,M1,g));
((Phi0, Phi0, Sneutrino g, Sneutrino (-g)), Scalar4 1,
G_G0G0SFSF (SN,M1,M1,g)) ]
let higgs_gold_sfermion' g m1 m2 =
[ ((A, Phi0, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1,
G_AG0SFSF (SL,m1,m2,g));
((Hp, Phim, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1,
G_HGSFSF (SL,m1,m2,g));
((Hm, Phip, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1,
G_HGSFSF (SL,m1,m2,g));
((Phip, Phim, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1,
G_GGSFSF (SL,m1,m2,g));
((Phi0, Phi0, Slepton (m1,g), Slepton (m2,-g)), Scalar4 1,
G_G0G0SFSF (SL,m1,m2,g));
((A, Phi0, Sup (m1,g), Sup (m2,-g)), Scalar4 1, G_AG0SFSF (SU,m1,m2,g));
((A, Phi0, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1,
G_AG0SFSF (SD,m1,m2,g));
((Hp, Phim, Sup (m1,g), Sup (m2,-g)), Scalar4 1, G_HGSFSF (SU,m1,m2,g));
((Hm, Phip, Sup (m1,g), Sup (m2,-g)), Scalar4 1, G_HGSFSF (SU,m1,m2,g));
((Hp, Phim, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1,
G_HGSFSF (SD,m1,m2,g));
((Hm, Phip, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1,
G_HGSFSF (SD,m1,m2,g));
((Phip, Phim, Sup (m1,g), Sup (m2,-g)), Scalar4 1,
G_GGSFSF (SU,m1,m2,g));
((Phip, Phim, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1,
G_GGSFSF (SD,m1,m2,g));
((Phi0, Phi0, Sup (m1,g), Sup (m2,-g)), Scalar4 1,
G_G0G0SFSF (SU,m1,m2,g));
((Phi0, Phi0, Sdown (m1,g), Sdown (m2,-g)), Scalar4 1,
G_G0G0SFSF (SD,m1,m2,g)) ]
let higgs_gold_sfermion g = List.flatten (Product.list2
(higgs_gold_sfermion' g) [M1;M2] [M1;M2])
let higgs_gold_squark' g h m1 m2 =
[ ((Hp, Phi0, Sup (m1,-g), Sdown (m2,h)), Scalar4 1,
G_HGSUSD (false,m1,m2,g,h));
((Hm, Phi0, Sup (m1,g), Sdown (m2,-h)), Scalar4 1,
G_HGSUSD (true,m1,m2,g,h));
((H_Heavy, Phip, Sup (m1,-g), Sdown (m2,h)), Scalar4 1,
G_H2GSUSD (false,m1,m2,g,h));
((H_Heavy, Phim, Sup (m1,g), Sdown (m2,-h)), Scalar4 1,
G_H2GSUSD (true,m1,m2,g,h));
((H_Light, Phip, Sup (m1,-g), Sdown (m2,h)), Scalar4 1,
G_H1GSUSD (false,m1,m2,g,h));
((H_Light, Phim, Sup (m1,g), Sdown (m2,-h)), Scalar4 1,
G_H1GSUSD (true,m1,m2,g,h));
((A, Phip, Sup (m1,-g), Sdown (m2,h)), Scalar4 1,
G_AGSUSD (false,m1,m2,g,h));
((A, Phim, Sup (m1,g), Sdown (m2,-h)), Scalar4 1,
G_AGSUSD (true,m1,m2,g,h));
((Phi0, Phip, Sup (m1,-g), Sdown (m2,h)), Scalar4 1,
G_GGSUSD (false,m1,m2,g,h));
((Phi0, Phim, Sup (m1,g), Sdown (m2,-h)), Scalar4 1,
G_GGSUSD (true,m1,m2,g,h)) ]
let higgs_gold_squark g h = List.flatten (Product.list2 (higgs_gold_squark'
g h) [M1;M2] [M1;M2])
let sneutrino4' (g,h) =
[ ((Sneutrino g, Sneutrino h, Sneutrino (-g), Sneutrino (-h)), Scalar4 1,
G_SN4 (g,h))]
let sneutrino4 = ThoList.flatmap sneutrino4'
[(1,1);(1,2);(1,3);(2,2);(2,3);(3,3)]
let sneu2_slep2_1' g h m1 m2 =
((Sneutrino (-g), Sneutrino g, Slepton (m1,-h), Slepton (m2,h)), Scalar4 1,
G_SN2SL2_1 (m1,m2,g,h))
let sneu2_slep2_2' (g,h) m1 m2 =
((Sneutrino g, Sneutrino (-h), Slepton (m1,-g), Slepton (m2,h)), Scalar4 1,
G_SN2SL2_2 (m1,m2,g,h))
let sneu2_slep2_1 g h = Product.list2 (sneu2_slep2_1' g h) [M1;M2] [M1;M2]
let sneu2_slep2_2 (g,h) = Product.list2 (sneu2_slep2_2' (g,h)) [M1;M2] [M1;M2]
(* The 4-slepton-vertices have the following structure: The sleptons come up in
pairs of a positive and a negative slepton of the same generation; there is
no vertex with e.g. two negative selectrons and two positive smuons, that of
course would be a contradiction to the conservation of the separate slepton
numbers of each generation which is not implemented in the MSSM. Because there
is no CKM-mixing for the sleptons (in case of massless neutrinos) we maximally
have two different generations of sleptons in a 4-slepton-vertex. *)
let slepton4_1gen' g (m1,m2,m3,m4) =
[ ((Slepton (m1,-g), Slepton (m2,g), Slepton (m3,-g), Slepton (m4,g)),
Scalar4 1, G_SL4 (m1,m2,m3,m4,g)) ]
let slepton4_1gen g = ThoList.flatmap (slepton4_1gen' g) [(M1,M1,M1,M1);
(M1,M1,M1,M2); (M1,M1,M2,M1); (M1,M1,M2,M2); (M1,M2,M1,M2); (M1,M2,M2,M1);
(M1,M2,M2,M2); (M2,M1,M2,M2); (M2,M2,M2,M2) ]
let slepton4_2gen' (g,h) (m1,m2) (m3,m4) =
((Slepton (m1,-g), Slepton (m2,g), Slepton (m3,-h), Slepton (m4,h)),
Scalar4 1, G_SL4_2 (m1,m2,m3,m4,g,h))
let slepton4_2gen (g,h) =
Product.list2 (slepton4_2gen' (g,h)) [(M1,M1);(M1,M2);(M2,M1);(M2,M2)]
[(M1,M1);(M1,M2);(M2,M1);(M2,M2)]
let sneu2_squark2' g h m1 m2 =
[ ((Sneutrino (-g), Sneutrino g, Sup (m1,-h), Sup (m2,h)), Scalar4 1,
G_SN2SQ2 (SU,m1,m2,g,h));
((Sneutrino (-g), Sneutrino g, Sdown (m1,-h), Sdown (m2,h)), Scalar4 1,
G_SN2SQ2 (SD,m1,m2,g,h)) ]
let sneu2_squark2 g h = List.flatten (Product.list2 (sneu2_squark2' g h)
[M1;M2] [M1;M2])
let slepton2_squark2'' g h m1 m2 m3 m4 =
[ ((Slepton (m1,-g), Slepton (m2,g), Sup (m3,-h), Sup (m4,h)), Scalar4 1,
G_SL2SQ2 (SU,m1,m2,m3,m4,g,h));
((Slepton (m1,-g), Slepton (m2,g), Sdown (m3,-h), Sdown (m4,h)),
Scalar4 1, G_SL2SQ2 (SD,m1,m2,m3,m4,g,h)) ]
let slepton2_squark2' g h m1 m2 =
List.flatten (Product.list2 (slepton2_squark2'' g h m1 m2) [M1;M2] [M1;M2])
let slepton2_squark2 g h =
List.flatten (Product.list2 (slepton2_squark2' g h) [M1;M2] [M1;M2])
let slep_sneu_squark2'' g1 g2 g3 m1 m2 m3 =
[ ((Sup (m1,-g1), Sdown (m2,g2), Slepton (m3,-g3), Sneutrino g3),
Scalar4 1, G_SUSDSNSL (false,m1,m2,m3,g1,g2,g3));
((Sup (m1,g1), Sdown (m2,-g2), Slepton (m3,g3), Sneutrino (-g3)),
Scalar4 1, G_SUSDSNSL (true,m1,m2,m3,g1,g2,g3)) ]
let slep_sneu_squark2' g1 g2 g3 m1 =
List.flatten (Product.list2 (slep_sneu_squark2'' g1 g2 g3 m1)
[M1;M2] [M1;M2])
let slep_sneu_squark2 g1 g2 =
List.flatten (Product.list2 (slep_sneu_squark2' g1 g2) [1;2;3] [M1;M2])
(* There are three kinds of 4-squark-vertices: Four up-Squarks, four down-squarks
or two up- and two down-squarks. *)
let sup4_1gen' g (m1,m2,m3,m4) =
[ ((Sup (m1,-g), Sup (m2,g), Sup (m3,-g), Sup (m4,g)), Scalar4 1,
G_SU4 (m1,m2,m3,m4,g)) ]
let sup4_1gen g = ThoList.flatmap (sup4_1gen' g) [(M1,M1,M1,M1);
(M1,M1,M1,M2); (M1,M1,M2,M1); (M1,M1,M2,M2); (M1,M2,M1,M2); (M1,M2,M2,M1);
(M1,M2,M2,M2); (M2,M1,M2,M2); (M2,M2,M2,M2) ]
let sup4_2gen' (g,h) (m1,m2) (m3,m4) =
((Sup (m1,-g), Sup (m2,g), Sup (m3,-h), Sup (m4,h)), Scalar4 1,
G_SU4_2 (m1,m2,m3,m4,g,h))
let sup4_2gen (g,h) =
Product.list2 (sup4_2gen' (g,h)) [(M1,M1);(M1,M2);(M2,M1);(M2,M2)]
[(M1,M1);(M1,M2);(M2,M1);(M2,M2)]
let sdown4_1gen' g (m1,m2,m3,m4) =
[ ((Sdown (m1,-g), Sdown (m2,g), Sdown (m3,-g), Sdown (m4,g)), Scalar4 1,
G_SD4 (m1,m2,m3,m4,g)) ]
let sdown4_1gen g = ThoList.flatmap (sdown4_1gen' g) [(M1,M1,M1,M1);
(M1,M1,M1,M2); (M1,M1,M2,M1); (M1,M1,M2,M2); (M1,M2,M1,M2); (M1,M2,M2,M1);
(M1,M2,M2,M2); (M2,M1,M2,M2); (M2,M2,M2,M2) ]
let sdown4_2gen' (g,h) (m1,m2) (m3,m4) =
((Sdown (m1,-g), Sdown (m2,g), Sdown (m3,-h), Sdown (m4,h)), Scalar4 1,
G_SD4_2 (m1,m2,m3,m4,g,h))
let sdown4_2gen (g,h) =
Product.list2 (sdown4_2gen' (g,h)) [(M1,M1);(M1,M2);(M2,M1);(M2,M2)]
[(M1,M1);(M1,M2);(M2,M1);(M2,M2)]
let sup2_sdown2_3 g1 g2 g3 g4 m1 m2 m3 m4 =
((Sup (m1,-g1), Sup (m2,g2), Sdown (m3,-g3), Sdown
(m4,g4)), Scalar4 1, G_SU2SD2 (m1,m2,m3,m4,g1,g2,g3,g4))
let sup2_sdown2_2 g1 g2 g3 g4 m1 m2 =
Product.list2 (sup2_sdown2_3 g1 g2 g3 g4 m1 m2) [M1;M2] [M1;M2]
let sup2_sdown2_1 g1 g2 g3 g4 =
List.flatten (Product.list2 (sup2_sdown2_2 g1 g2 g3 g4) [M1;M2] [M1;M2])
let sup2_sdown2 g1 g2 =
List.flatten (Product.list2 (sup2_sdown2_1 g1 g2) [1;2;3] [1;2;3])
let quartic_grav_gauge g m =
[ ((Grino, Slepton (m, -g), Ga, L g), GBBG (1, Gravbar, SLRV, Psi), G_Gr4A_Sl (g,m));
((L (-g), Slepton (m, g), Ga, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4A_Slc (g,m));
((Grino, Sup (m, -g), Ga, U g), GBBG (1, Gravbar, SLRV, Psi), G_Gr4A_Su (g,m));
((U (-g), Sup (m, g), Ga, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4A_Suc (g,m));
((Grino, Sdown (m, -g), Ga, D g), GBBG (1, Gravbar, SLRV, Psi), G_Gr4A_Sd (g,m));
((D (-g), Sdown (m, g), Ga, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4A_Sdc (g,m));
((Grino, Slepton (m, -g), Z, L g), GBBG (1, Gravbar, SLRV, Psi), G_Gr4Z_Sl (g,m));
((L (-g), Slepton (m, g), Z, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4Z_Slc (g,m));
((Grino, Sup (m, -g), Z, U g), GBBG (1, Gravbar, SLRV, Psi), G_Gr4Z_Su (g,m));
((U (-g), Sup (m, g), Z, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4Z_Suc (g,m));
((Grino, Sdown (m, -g), Z, D g), GBBG (1, Gravbar, SLRV, Psi), G_Gr4Z_Sd (g,m));
((D (-g), Sdown (m, g), Z, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4Z_Sdc (g,m));
((Grino, Sup (m, -g), Gl, U g), GBBG (1, Gravbar, SLRV, Psi), G_Gr4Gl_Su (g,m));
((U (-g), Sup (m, g), Gl, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4Gl_Suc (g,m));
((Grino, Sdown (m, -g), Gl, D g), GBBG (1, Gravbar, SLRV, Psi), G_Gr4Gl_Sd (g,m));
((D (-g), Sdown (m, g), Gl, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4Gl_Sdc (g,m));
((Grino, Slepton (m, -g), Wp, N g), GBBG (1, Gravbar, SLV, Psi), G_Gr4W_Sl (g,m));
((N (-g), Slepton (m, g), Wm, Grino), GBBG (1, Psibar, SLV, Grav), G_Gr4Z_Slc (g,m));
((Grino, Sup (m, -g), Wp, D g), GBBG (1, Gravbar, SLV, Psi), G_Gr4W_Su (g,m));
((D (-g), Sup (m, g), Wm, Grino), GBBG (1, Psibar, SLV, Grav), G_Gr4W_Suc (g,m));
((Grino, Sdown (m, -g), Wm, U g), GBBG (1, Gravbar, SLV, Psi), G_Gr4W_Sd (g,m));
((U (-g), Sdown (m, g), Wp, Grino), GBBG (1, Psibar, SLV, Grav), G_Gr4W_Sdc (g,m)) ]
let quartic_grav_sneutrino g =
[ ((Grino, Sneutrino (-g), Z, N g), GBBG (1, Gravbar, SLV, Psi), G_Gr4Z_Sn);
((N (-g), Sneutrino g, Z, Grino), GBBG (1, Psibar, SLV, Grav), G_Gr4Z_Snc);
((Grino, Sneutrino (-g), Wp, L g), GBBG (1, Gravbar, SLV, Psi), G_Gr4W_Sn);
((L (-g), Sneutrino g, Wm, Grino), GBBG (1, Psibar, SLV, Grav), G_Gr4W_Snc) ]
let quartic_grav_neu n =
[ ((Grino, Wp, Wm, Neutralino n), GBBG (1, Gravbar, V2LR, Chi), G_Gr4_Neu n);
((Grino, H_Light, Z, Neutralino n), GBBG (1, Gravbar, SLRV, Chi), G_Gr4_Z_H1 n);
((Grino, H_Heavy, Z, Neutralino n), GBBG (1, Gravbar, SLRV, Chi), G_Gr4_Z_H2 n);
((Grino, A, Z, Neutralino n), GBBG (1, Gravbar, SLRV, Chi), G_Gr4_Z_H3 n);
((Grino, Hm, Wp, Neutralino n), GBBG (1, Gravbar, SLRV, Chi), G_Gr4_W_H n);
((Grino, Hp, Wm, Neutralino n), GBBG (1, Gravbar, SLRV, Chi), G_Gr4_W_Hc n) ]
let quartic_grav_char c =
let cc = conj_char c in
[ ((Grino, Wm, Ga, Chargino c), GBBG (1, Gravbar, V2LR, Psi), G_Gr4_A_Ch c);
((Grino, Wm, Z, Chargino c), GBBG (1, Gravbar, V2LR, Psi), G_Gr4_Z_Ch c);
((Chargino cc, Wp, Ga, Grino), GBBG ((-1), Psibar, V2LR, Grav), G_Gr4_A_Ch cc);
((Chargino cc, Wp, Z, Grino), GBBG ((-1), Psibar, V2LR, Grav), G_Gr4_Z_Ch cc);
((Grino, Hm, Ga, Chargino c), GBBG (1, Gravbar, SLRV, Psi), G_Gr4_H_A c);
((Chargino cc, Hp, Ga, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4_H_A cc);
((Grino, Hm, Z, Chargino c), GBBG (1, Gravbar, SLRV, Psi), G_Gr4_H_Z c);
((Chargino cc, Hp, Z, Grino), GBBG (1, Psibar, SLRV, Grav), G_Gr4_H_Z cc)]
let quartic_gravitino =
[ ((Grino, Gl, Gl, Gluino), GBBG (1, Gravbar, V2, Chi), G_GravGl)] @
ThoList.flatmap quartic_grav_neu [N1; N2; N3; N4] @
ThoList.flatmap quartic_grav_char [C1; C2] @
List.flatten (Product.list2 quartic_grav_gauge [1; 2; 3] [M1; M2]) @
ThoList.flatmap quartic_grav_sneutrino [1; 2; 3]
let vertices3'' =
if Flags.ckm_present then
(ThoList.flatmap electromagnetic_currents_3 [1;2;3] @
ThoList.flatmap electromagnetic_currents_2 [C1;C2] @
List.flatten (Product.list2
electromagnetic_sfermion_currents [1;2;3] [M1;M2]) @
ThoList.flatmap neutral_currents [1;2;3] @
ThoList.flatmap neutral_sfermion_currents [1;2;3] @
ThoList.flatmap charged_currents [1;2;3] @
List.flatten (Product.list2 charged_slepton_currents [1;2;3]
[M1;M2]) @
List.flatten (Product.list2 charged_quark_currents [1;2;3]
[1;2;3]) @
List.flatten (Product.list2 charged_squark_currents [1;2;3]
[1;2;3]) @
ThoList.flatmap yukawa_higgs_quark [(1,3);(2,3);(3,3);(3,1);(3,2)] @
yukawa_higgs 3 @ yukawa_n @
ThoList.flatmap yukawa_c [C1;C2] @
ThoList.flatmap yukawa_cq [C1;C2] @
List.flatten (Product.list2 charged_chargino_currents [N1;N2;N3;N4]
[C1;C2]) @ triple_gauge @
ThoList.flatmap neutral_Z_1 [(N1,N2);(N1,N3);(N1,N4);(N2,N3);(N2,N4);
(N3,N4)] @
ThoList.flatmap neutral_Z_2 [N1;N2;N3;N4] @
Product.list2 charged_Z [C1;C2] [C1;C2] @
gauge_higgs @ higgs @ yukawa_higgs_2 @
List.flatten (Product.list2 higgs_charg_neutr [N1;N2;N3;N4] [C1;C2]) @
higgs_neutr @ higgs_sneutrino @ higgs_sfermion @
higgs_squark @ yukawa_v @
ThoList.flatmap col_currents [1;2;3] @
List.flatten (Product.list2 col_sfermion_currents [1;2;3] [M1;M2]))
else
(ThoList.flatmap electromagnetic_currents_3 [1;2;3] @
ThoList.flatmap electromagnetic_currents_2 [C1;C2] @
List.flatten (Product.list2
electromagnetic_sfermion_currents [1;2;3] [M1;M2]) @
ThoList.flatmap neutral_currents [1;2;3] @
ThoList.flatmap neutral_sfermion_currents [1;2;3] @
ThoList.flatmap charged_currents [1;2;3] @
List.flatten (Product.list2 charged_slepton_currents [1;2;3]
[M1;M2]) @
charged_quark_currents 1 1 @
charged_quark_currents 2 2 @
charged_quark_currents 3 3 @
charged_squark_currents 1 1 @
charged_squark_currents 2 2 @
charged_squark_currents 3 3 @
ThoList.flatmap yukawa_higgs_quark [(3,3)] @
yukawa_higgs 3 @ yukawa_n @
ThoList.flatmap yukawa_c [C1;C2] @
ThoList.flatmap yukawa_cq [C1;C2] @
List.flatten (Product.list2 charged_chargino_currents [N1;N2;N3;N4]
[C1;C2]) @ triple_gauge @
ThoList.flatmap neutral_Z_1 [(N1,N2);(N1,N3);(N1,N4);(N2,N3);(N2,N4);
(N3,N4)] @
ThoList.flatmap neutral_Z_2 [N1;N2;N3;N4] @
Product.list2 charged_Z [C1;C2] [C1;C2] @
gauge_higgs @ higgs @ yukawa_higgs_2 @
List.flatten (Product.list2 higgs_charg_neutr [N1;N2;N3;N4] [C1;C2]) @
higgs_neutr @ higgs_sneutrino @ higgs_sfermion @
higgs_squark @ yukawa_v @
ThoList.flatmap col_currents [1;2;3] @
List.flatten (Product.list2 col_sfermion_currents [1;2;3] [M1;M2]))
(*i OLD VERSION !!!!!!!!!!!!!!!!!!!!!
let vertices3'' =
(ThoList.flatmap electromagnetic_currents_3 [1;2;3] @
ThoList.flatmap electromagnetic_currents_2 [C1;C2] @
List.flatten (Product.list2
electromagnetic_sfermion_currents [1;2;3] [M1;M2]) @
ThoList.flatmap neutral_currents [1;2;3] @
ThoList.flatmap neutral_sfermion_currents [1;2;3] @
ThoList.flatmap charged_currents [1;2;3] @
List.flatten (Product.list2 charged_slepton_currents [1;2;3]
[M1;M2]) @
ThoList.flatmap yukawa_higgs_quark [(3,3)] @
(if Flags.ckm_present then
List.flatten (Product.list2 charged_quark_currents [1;2;3]
[1;2;3]) @
List.flatten (Product.list2 charged_squark_currents [1;2;3]
[1;2;3]) @
ThoList.flatmap yukawa_higgs_quark [(1,3);(2,3);(3,3);(3,1);(3,2)]
else
charged_quark_currents 1 1 @
charged_quark_currents 2 2 @
charged_quark_currents 3 3 @
charged_squark_currents 1 1 @
charged_squark_currents 2 2 @
charged_squark_currents 3 3 @
ThoList.flatmap yukawa_higgs_quark [(3,3)]) @
(*i ThoList.flatmap yukawa_higgs [1;2;3] @ i*)
yukawa_higgs 3 @ yukawa_n @
ThoList.flatmap yukawa_c [C1;C2] @
ThoList.flatmap yukawa_cq [C1;C2] @
List.flatten (Product.list2 charged_chargino_currents [N1;N2;N3;N4]
[C1;C2]) @ triple_gauge @
ThoList.flatmap neutral_Z_1 [(N1,N2);(N1,N3);(N1,N4);(N2,N3);(N2,N4);
(N3,N4)] @
ThoList.flatmap neutral_Z_2 [N1;N2;N3;N4] @
Product.list2 charged_Z [C1;C2] [C1;C2] @
gauge_higgs @ higgs @ yukawa_higgs_2 @
(*i List.flatten (Product.list2 yukawa_higgs_quark [1;2;3] [1;2;3]) @ i*)
List.flatten (Product.list2 higgs_charg_neutr [N1;N2;N3;N4] [C1;C2]) @
higgs_neutr @ higgs_sneutrino @ higgs_sfermion @
(*i ThoList.flatmap higgs_sfermion [1;2;3] @ i*)
higgs_squark @ yukawa_v @
ThoList.flatmap col_currents [1;2;3] @
List.flatten (Product.list2 col_sfermion_currents [1;2;3] [M1;M2]))
i*)
let vertices3' =
if Flags.gravitino then (vertices3'' @ triple_gravitino)
else vertices3''
let vertices3 =
if Flags.include_goldstone then
(vertices3' @ yukawa_goldstone 3 @
gauge_higgs_gold @ higgs_gold @ yukawa_goldstone_2 @
(if Flags.ckm_present then
List.flatten (Product.list2 yukawa_goldstone_quark [1;2;3]
[1;2;3]) @
List.flatten (Product.list2 goldstone_charg_neutr [N1;N2;N3;N4]
[C1;C2])
else
yukawa_goldstone_quark 1 1 @
yukawa_goldstone_quark 2 2 @
yukawa_goldstone_quark 3 3) @
goldstone_neutr @ goldstone_sfermion @ goldstone_squark)
else vertices3'
(* let vertices4 = [] *)
let vertices4''' =
(quartic_gauge @ higgs4 @ gauge_higgs4 @
ThoList.flatmap gauge_sfermion4 [1;2;3] @
List.flatten (Product.list2 gauge_squark4 [1;2;3] [1;2;3]) @
List.flatten (Product.list2 gluon2_squark2 [1;2;3] [M1;M2]) @
List.flatten (Product.list2 gluon_w_squark [1;2;3] [1;2;3]) @
ThoList.flatmap gluon_gauge_squark [1;2;3])
let vertices4'' =
if Flags.gravitino then (vertices4''' @ quartic_gravitino)
else vertices4'''
let vertices4' =
if Flags.include_four then
(vertices4'' @
ThoList.flatmap higgs_sfermion4 [1;2;3] @
ThoList.flatmap higgs_sneutrino4 [1;2;3] @
List.flatten (Product.list2 higgs_squark4 [1;2;3] [1;2;3]) @
sneutrino4 @
List.flatten (Product.list2 sneu2_slep2_1 [1;2;3] [1;2;3]) @
ThoList.flatmap sneu2_slep2_2 [(1,2);(1,3);(2,3);(2,1);(3,1);(3,2)] @
ThoList.flatmap slepton4_1gen [1;2;3] @
ThoList.flatmap slepton4_2gen [(1,2);(1,3);(2,3)] @
List.flatten (Product.list2 sneu2_squark2 [1;2;3] [1;2;3]) @
List.flatten (Product.list2 slepton2_squark2 [1;2;3] [1;2;3]) @
List.flatten (Product.list2 slep_sneu_squark2 [1;2;3] [1;2;3]) @
ThoList.flatmap sup4_1gen [1;2;3] @
ThoList.flatmap sup4_2gen [(1,2);(1,3);(2,3)] @
ThoList.flatmap sdown4_1gen [1;2;3] @
ThoList.flatmap sdown4_2gen [(1,2);(1,3);(2,3)] @
List.flatten (Product.list2 sup2_sdown2 [1;2;3] [1;2;3]))
else
vertices4''
let vertices4 =
if Flags.include_goldstone then
(vertices4' @ higgs_gold4 @ gauge_higgs_gold4 @ goldstone4 @
ThoList.flatmap higgs_gold_sneutrino [1;2;3] @
ThoList.flatmap higgs_gold_sfermion [1;2;3] @
List.flatten (Product.list2 higgs_gold_squark [1;2;3] [1;2;3]))
else
vertices4'
let vertices () = (vertices3, vertices4, [])
let table = F.of_vertices (vertices ())
let fuse2 = F.fuse2 table
let fuse3 = F.fuse3 table
let fuse = F.fuse table
let max_degree () = 4
let flavor_of_string s =
match s with
| "e-" -> L 1 | "e+" -> L (-1)
| "mu-" -> L 2 | "mu+" -> L (-2)
| "tau-" -> L 3 | "tau+" -> L (-3)
| "nue" -> N 1 | "nuebar" -> N (-1)
| "numu" -> N 2 | "numubar" -> N (-2)
| "nutau" -> N 3 | "nutaubar" -> N (-3)
| "se1-" -> Slepton (M1,1) | "se1+" -> Slepton (M1,-1)
| "smu1-" -> Slepton (M1,2) | "smu1+" -> Slepton (M1,-2)
| "stau1-" -> Slepton (M1,3) | "stau1+" -> Slepton (M1,-3)
| "se2-" -> Slepton (M2,1) | "se2+" -> Slepton (M2,-1)
| "smu2-" -> Slepton (M2,2) | "smu2+" -> Slepton (M2,-2)
| "stau2-" -> Slepton (M2,3) | "stau2+" -> Slepton (M2,-3)
| "snue" -> Sneutrino 1 | "snue*" -> Sneutrino (-1)
| "snumu" -> Sneutrino 2 | "snumu*" -> Sneutrino (-2)
| "snutau" -> Sneutrino 3 | "snutau*" -> Sneutrino (-3)
| "u" -> U 1 | "ubar" -> U (-1)
| "c" -> U 2 | "cbar" -> U (-2)
| "t" -> U 3 | "tbar" -> U (-3)
| "d" -> D 1 | "dbar" -> D (-1)
| "s" -> D 2 | "sbar" -> D (-2)
| "b" -> D 3 | "bbar" -> D (-3)
| "A" -> Ga | "Z" | "Z0" -> Z
| "W+" -> Wp | "W-" -> Wm
| "gl" | "g" -> Gl
| "H" -> H_Heavy | "h" -> H_Light | "A0" -> A
| "H+" -> Hp | "H-" -> Hm
| "phi0" -> Phi0 | "phi+" -> Phip | "phim" -> Phim
| "su1" -> Sup (M1,1) | "su1c" -> Sup (M1,-1)
| "sc1" -> Sup (M1,2) | "sc1c" -> Sup (M1,-2)
| "st1" -> Sup (M1,3) | "st1c" -> Sup (M1,-3)
| "su2" -> Sup (M2,1) | "su2c" -> Sup (M2,-1)
| "sc2" -> Sup (M2,2) | "sc2c" -> Sup (M2,-2)
| "st2" -> Sup (M2,3) | "st2c" -> Sup (M2,-3)
| "sgl" | "sg" -> Gluino
| "sd1" -> Sdown (M1,1) | "sd1c" -> Sdown (M1,-1)
| "ss1" -> Sdown (M1,2) | "ss1c" -> Sdown (M1,-2)
| "sb1" -> Sdown (M1,3) | "sb1c" -> Sdown (M1,-3)
| "sd2" -> Sdown (M2,1) | "sd2c" -> Sdown (M2,-1)
| "ss2" -> Sdown (M2,2) | "ss2c" -> Sdown (M2,-2)
| "sb2" -> Sdown (M2,3) | "sb2c" -> Sdown (M2,-3)
| "neu1" -> Neutralino N1 | "neu2" -> Neutralino N2
| "neu3" -> Neutralino N3 | "neu4" -> Neutralino N4
| "ch1+" -> Chargino C1 | "ch2+" -> Chargino C2
| "ch1-" -> Chargino C1c | "ch2-" -> Chargino C2c
| "GR" -> Grino
| _ -> invalid_arg "Modellib_MSSM.MSSM.flavor_of_string"
let flavor_to_string = function
| L 1 -> "e-" | L (-1) -> "e+"
| L 2 -> "mu-" | L (-2) -> "mu+"
| L 3 -> "tau-" | L (-3) -> "tau+"
| N 1 -> "nue" | N (-1) -> "nuebar"
| N 2 -> "numu" | N (-2) -> "numubar"
| N 3 -> "nutau" | N (-3) -> "nutaubar"
| U 1 -> "u" | U (-1) -> "ubar"
| U 2 -> "c" | U (-2) -> "cbar"
| U 3 -> "t" | U (-3) -> "tbar"
| D 1 -> "d" | D (-1) -> "dbar"
| D 2 -> "s" | D (-2) -> "sbar"
| D 3 -> "b" | D (-3) -> "bbar"
| L _ -> invalid_arg
"Modellib_MSSM.MSSM.flavor_to_string: invalid lepton"
| N _ -> invalid_arg
"Modellib_MSSM.MSSM.flavor_to_string: invalid neutrino"
| U _ -> invalid_arg
"Modellib_MSSM.MSSM.flavor_to_string: invalid up type quark"
| D _ -> invalid_arg
"Modellib_MSSM.MSSM.flavor_to_string: invalid down type quark"
| Gl -> "gl" | Gluino -> "sgl"
| Ga -> "A" | Z -> "Z" | Wp -> "W+" | Wm -> "W-"
| Phip -> "phi+" | Phim -> "phi-" | Phi0 -> "phi0"
| H_Heavy -> "H" | H_Light -> "h" | A -> "A0"
| Hp -> "H+" | Hm -> "H-"
| Slepton (M1,1) -> "se1-" | Slepton (M1,-1) -> "se1+"
| Slepton (M1,2) -> "smu1-" | Slepton (M1,-2) -> "smu1+"
| Slepton (M1,3) -> "stau1-" | Slepton (M1,-3) -> "stau1+"
| Slepton (M2,1) -> "se2-" | Slepton (M2,-1) -> "se2+"
| Slepton (M2,2) -> "smu2-" | Slepton (M2,-2) -> "smu2+"
| Slepton (M2,3) -> "stau2-" | Slepton (M2,-3) -> "stau2+"
| Sneutrino 1 -> "snue" | Sneutrino (-1) -> "snue*"
| Sneutrino 2 -> "snumu" | Sneutrino (-2) -> "snumu*"
| Sneutrino 3 -> "snutau" | Sneutrino (-3) -> "snutau*"
| Sup (M1,1) -> "su1" | Sup (M1,-1) -> "su1c"
| Sup (M1,2) -> "sc1" | Sup (M1,-2) -> "sc1c"
| Sup (M1,3) -> "st1" | Sup (M1,-3) -> "st1c"
| Sup (M2,1) -> "su2" | Sup (M2,-1) -> "su2c"
| Sup (M2,2) -> "sc2" | Sup (M2,-2) -> "sc2c"
| Sup (M2,3) -> "st2" | Sup (M2,-3) -> "st2c"
| Sdown (M1,1) -> "sd1" | Sdown (M1,-1) -> "sd1c"
| Sdown (M1,2) -> "ss1" | Sdown (M1,-2) -> "ss1c"
| Sdown (M1,3) -> "sb1" | Sdown (M1,-3) -> "sb1c"
| Sdown (M2,1) -> "sd2" | Sdown (M2,-1) -> "sd2c"
| Sdown (M2,2) -> "ss2" | Sdown (M2,-2) -> "ss2c"
| Sdown (M2,3) -> "sb2" | Sdown (M2,-3) -> "sb2c"
| Neutralino N1 -> "neu1"
| Neutralino N2 -> "neu2"
| Neutralino N3 -> "neu3"
| Neutralino N4 -> "neu4"
| Slepton _ -> invalid_arg
"Modellib_MSSM.MSSM.flavor_to_string: invalid slepton"
| Sneutrino _ -> invalid_arg
"Modellib_MSSM.MSSM.flavor_to_string: invalid sneutrino"
| Sup _ -> invalid_arg
"Modellib_MSSM.MSSM.flavor_to_string: invalid up type squark"
| Sdown _ -> invalid_arg
"Modellib_MSSM.MSSM.flavor_to_string: invalid down type squark"
| Chargino C1 -> "ch1+" | Chargino C1c -> "ch1-"
| Chargino C2 -> "ch2+" | Chargino C2c -> "ch2-"
| Grino -> "GR"
let flavor_symbol = function
| L g when g > 0 -> "l" ^ string_of_int g
| L g -> "l" ^ string_of_int (abs g) ^ "b"
| N g when g > 0 -> "n" ^ string_of_int g
| N g -> "n" ^ string_of_int (abs g) ^ "b"
| U g when g > 0 -> "u" ^ string_of_int g
| U g -> "u" ^ string_of_int (abs g) ^ "b"
| D g when g > 0 -> "d" ^ string_of_int g
| D g -> "d" ^ string_of_int (abs g) ^ "b"
| Gl -> "gl" | Ga -> "a" | Z -> "z"
| Wp -> "wp" | Wm -> "wm"
| Slepton (M1,g) when g > 0 -> "sl1" ^ string_of_int g
| Slepton (M1,g) -> "sl1c" ^ string_of_int (abs g)
| Slepton (M2,g) when g > 0 -> "sl2" ^ string_of_int g
| Slepton (M2,g) -> "sl2c" ^ string_of_int (abs g)
| Sneutrino g when g > 0 -> "sn" ^ string_of_int g
| Sneutrino g -> "snc" ^ string_of_int (abs g)
| Sup (M1,g) when g > 0 -> "su1" ^ string_of_int g
| Sup (M1,g) -> "su1c" ^ string_of_int (abs g)
| Sup (M2,g) when g > 0 -> "su2" ^ string_of_int g
| Sup (M2,g) -> "su2c" ^ string_of_int (abs g)
| Sdown (M1,g) when g > 0 -> "sd1" ^ string_of_int g
| Sdown (M1,g) -> "sd1c" ^ string_of_int (abs g)
| Sdown (M2,g) when g > 0 -> "sd2" ^ string_of_int g
| Sdown (M2,g) -> "sd2c" ^ string_of_int (abs g)
| Neutralino n -> "neu" ^ (string_of_neu n)
| Chargino c when (int_of_char c) > 0 -> "cp" ^ string_of_char c
| Chargino c -> "cm" ^ string_of_int (abs (int_of_char c))
| Gluino -> "sgl" | Phip -> "pp" | Phim -> "pm" | Phi0 -> "p0"
| H_Heavy -> "h0h" | H_Light -> "h0l" | A -> "a0"
| Hp -> "hp" | Hm -> "hm" | Grino -> "gv"
let flavor_to_TeX = function
| L 1 -> "e^-" | L (-1) -> "e^+"
| L 2 -> "\\mu^-" | L (-2) -> "\\mu^+"
| L 3 -> "\\tau^-" | L (-3) -> "\\tau^+"
| N 1 -> "\\nu_e" | N (-1) -> "\\bar{\\nu}_e"
| N 2 -> "\\nu_\\mu" | N (-2) -> "\\bar{\\nu}_\\mu"
| N 3 -> "\\nu_\\tau" | N (-3) -> "\\bar{\\nu}_\\tau"
| U 1 -> "u" | U (-1) -> "\\bar{u}"
| U 2 -> "c" | U (-2) -> "\\bar{c}"
| U 3 -> "t" | U (-3) -> "\\bar{t}"
| D 1 -> "d" | D (-1) -> "\\bar{d}"
| D 2 -> "s" | D (-2) -> "\\bar{s}"
| D 3 -> "b" | D (-3) -> "\\bar{b}"
| L _ -> invalid_arg
"Modellib_MSSM.MSSM.flavor_to_TeX: invalid lepton"
| N _ -> invalid_arg
"Modellib_MSSM.MSSM.flavor_to_TeX: invalid neutrino"
| U _ -> invalid_arg
"Modellib_MSSM.MSSM.flavor_to_TeX: invalid up type quark"
| D _ -> invalid_arg
"Modellib_MSSM.MSSM.flavor_to_TeX: invalid down type quark"
| Gl -> "g" | Gluino -> "\\widetilde{g}"
| Ga -> "\\gamma" | Z -> "Z" | Wp -> "W^+" | Wm -> "W^-"
| Phip -> "\\phi^+" | Phim -> "\\phi^-" | Phi0 -> "\\phi^0"
| H_Heavy -> "H^0" | H_Light -> "h^0" | A -> "A^0"
| Hp -> "H^+" | Hm -> "H^-"
| Slepton (M1,1) -> "\\widetilde{e}_1^-"
| Slepton (M1,-1) -> "\\widetilde{e}_1^+"
| Slepton (M1,2) -> "\\widetilde{\\mu}_1^-"
| Slepton (M1,-2) -> "\\widetilde{\\mu}_1^+"
| Slepton (M1,3) -> "\\widetilde{\\tau}_1^-"
| Slepton (M1,-3) -> "\\widetilde{\\tau}_1^+"
| Slepton (M2,1) -> "\\widetilde{e}_2^-"
| Slepton (M2,-1) -> "\\widetilde{e}_2^+"
| Slepton (M2,2) -> "\\widetilde{\\mu}_2^-"
| Slepton (M2,-2) -> "\\widetilde{\\mu}_2^+"
| Slepton (M2,3) -> "\\widetilde{\\tau}_2^-"
| Slepton (M2,-3) -> "\\widetilde{\\tau}_2^+"
| Sneutrino 1 -> "\\widetilde{\\nu}_e"
| Sneutrino (-1) -> "\\widetilde{\\nu}_e^*"
| Sneutrino 2 -> "\\widetilde{\\nu}_\\mu"
| Sneutrino (-2) -> "\\widetilde{\\nu}_\\mu^*"
| Sneutrino 3 -> "\\widetilde{\\nu}_\\tau"
| Sneutrino (-3) -> "\\widetilde{\\nu}_\\tau^*"
| Sup (M1,1) -> "\\widetilde{u}_1"
| Sup (M1,-1) -> "\\widetilde{u}_1^*"
| Sup (M1,2) -> "\\widetilde{c}_1"
| Sup (M1,-2) -> "\\widetilde{c}_1^*"
| Sup (M1,3) -> "\\widetilde{t}_1"
| Sup (M1,-3) -> "\\widetilde{t}_1^*"
| Sup (M2,1) -> "\\widetilde{u}_2"
| Sup (M2,-1) -> "\\widetilde{u}_2^*"
| Sup (M2,2) -> "\\widetilde{c}_2"
| Sup (M2,-2) -> "\\widetilde{c}_2^*"
| Sup (M2,3) -> "\\widetilde{t}_2"
| Sup (M2,-3) -> "\\widetilde{t}_2^*"
| Sdown (M1,1) -> "\\widetilde{d}_1"
| Sdown (M1,-1) -> "\\widetilde{d}_1^*"
| Sdown (M1,2) -> "\\widetilde{s}_1"
| Sdown (M1,-2) -> "\\widetilde{s}_1^*"
| Sdown (M1,3) -> "\\widetilde{b}_1"
| Sdown (M1,-3) -> "\\widetilde{b}_1^*"
| Sdown (M2,1) -> "\\widetilde{d}_2"
| Sdown (M2,-1) -> "\\widetilde{d}_2^*"
| Sdown (M2,2) -> "\\widetilde{s}_2"
| Sdown (M2,-2) -> "\\widetilde{s}_2^*"
| Sdown (M2,3) -> "\\widetilde{b}_2"
| Sdown (M2,-3) -> "\\widetilde{b}_2^*"
| Neutralino N1 -> "\\widetilde{\\chi}^0_1"
| Neutralino N2 -> "\\widetilde{\\chi}^0_2"
| Neutralino N3 -> "\\widetilde{\\chi}^0_3"
| Neutralino N4 -> "\\widetilde{\\chi}^0_4"
| Slepton _ -> invalid_arg
"Modellib_MSSM.MSSM.flavor_to_TeX: invalid slepton"
| Sneutrino _ -> invalid_arg
"Modellib_MSSM.MSSM.flavor_to_TeX: invalid sneutrino"
| Sup _ -> invalid_arg
"Modellib_MSSM.MSSM.flavor_to_TeX: invalid up type squark"
| Sdown _ -> invalid_arg
"Modellib_MSSM.MSSM.flavor_to_TeX: invalid down type squark"
| Chargino C1 -> "\\widetilde{\\chi}_1^+"
| Chargino C1c -> "\\widetilde{\\chi}_1^-"
| Chargino C2 -> "\\widetilde{\\chi}_2^+"
| Chargino C2c -> "\\widetilde{\\chi}_2^-"
| Grino -> "\\widetilde{G}"
let pdg = function
| L g when g > 0 -> 9 + 2*g
| L g -> - 9 + 2*g
| N g when g > 0 -> 10 + 2*g
| N g -> - 10 + 2*g
| U g when g > 0 -> 2*g
| U g -> 2*g
| D g when g > 0 -> - 1 + 2*g
| D g -> 1 + 2*g
| Gl -> 21 | Ga -> 22 | Z -> 23
| Wp -> 24 | Wm -> (-24)
| H_Light -> 25 | H_Heavy -> 35 | A -> 36
| Hp -> 37 | Hm -> (-37)
| Phip | Phim -> 27 | Phi0 -> 26
| Slepton (M1,g) when g > 0 -> 1000009 + 2*g
| Slepton (M1,g) -> - 1000009 + 2*g
| Slepton (M2,g) when g > 0 -> 2000009 + 2*g
| Slepton (M2,g) -> - 2000009 + 2*g
| Sneutrino g when g > 0 -> 1000010 + 2*g
| Sneutrino g -> - 1000010 + 2*g
| Sup (M1,g) when g > 0 -> 1000000 + 2*g
| Sup (M1,g) -> - 1000000 + 2*g
| Sup (M2,g) when g > 0 -> 2000000 + 2*g
| Sup (M2,g) -> - 2000000 + 2*g
| Sdown (M1,g) when g > 0 -> 999999 + 2*g
| Sdown (M1,g) -> - 999999 + 2*g
| Sdown (M2,g) when g > 0 -> 1999999 + 2*g
| Sdown (M2,g) -> - 1999999 + 2*g
| Gluino -> 1000021
| Grino -> 1000039
| Chargino C1 -> 1000024 | Chargino C1c -> (-1000024)
| Chargino C2 -> 1000037 | Chargino C2c -> (-1000037)
| Neutralino N1 -> 1000022 | Neutralino N2 -> 1000023
| Neutralino N3 -> 1000025 | Neutralino N4 -> 1000035
(* We must take care of the pdg numbers for the two different kinds of
sfermions in the MSSM. The particle data group in its Monte Carlo particle
numbering scheme takes only into account mixtures of the third generation
squarks and the stau. For the other sfermions we will use the number of the
lefthanded field for the lighter mixed state and the one for the righthanded
for the heavier. Below are the official pdg numbers from the Particle
Data Group. In order not to produce arrays with some million entries in
the Fortran code for the masses and the widths we introduce our private
pdg numbering scheme which only extends not too far beyond 42.
Our private scheme then has the following pdf numbers (for the sparticles
the subscripts $L/R$ and $1/2$ are taken synonymously):
\begin{center}
\renewcommand{\arraystretch}{1.2}
\begin{tabular}{|r|l|l|}\hline
$d$ & down-quark & 1 \\\hline
$u$ & up-quark & 2 \\\hline
$s$ & strange-quark & 3 \\\hline
$c$ & charm-quark & 4 \\\hline
$b$ & bottom-quark & 5 \\\hline
$t$ & top-quark & 6 \\\hline\hline
$e^-$ & electron & 11 \\\hline
$\nu_e$ & electron-neutrino & 12 \\\hline
$\mu^-$ & muon & 13 \\\hline
$\nu_\mu$ & muon-neutrino & 14 \\\hline
$\tau^-$ & tau & 15 \\\hline
$\nu_\tau$ & tau-neutrino & 16 \\\hline\hline
$g$ & gluon & (9) 21 \\\hline
$\gamma$ & photon & 22 \\\hline
$Z^0$ & Z-boson & 23 \\\hline
$W^+$ & W-boson & 24 \\\hline\hline
$h^0$ & light Higgs boson & 25 \\\hline
$H^0$ & heavy Higgs boson & 35 \\\hline
$A^0$ & pseudoscalar Higgs & 36 \\\hline
$H^+$ & charged Higgs & 37 \\\hline\hline
$\widetilde{\psi}_\mu$ & gravitino & 39 \\\hline\hline
$\widetilde{d}_L$ & down-squark 1 & 41 \\\hline
$\widetilde{u}_L$ & up-squark 1 & 42 \\\hline
$\widetilde{s}_L$ & strange-squark 1 & 43 \\\hline
$\widetilde{c}_L$ & charm-squark 1 & 44 \\\hline
$\widetilde{b}_L$ & bottom-squark 1 & 45 \\\hline
$\widetilde{t}_L$ & top-squark 1 & 46 \\\hline
$\widetilde{d}_R$ & down-squark 2 & 47 \\\hline
$\widetilde{u}_R$ & up-squark 2 & 48 \\\hline
$\widetilde{s}_R$ & strange-squark 2 & 49 \\\hline
$\widetilde{c}_R$ & charm-squark 2 & 50 \\\hline
$\widetilde{b}_R$ & bottom-squark 2 & 51 \\\hline
$\widetilde{t}_R$ & top-squark 2 & 52 \\\hline\hline
$\widetilde{e}_L$ & selectron 1 & 53 \\\hline
$\widetilde{\nu}_{e,L}$ & electron-sneutrino & 54 \\\hline
$\widetilde{\mu}_L$ & smuon 1 & 55 \\\hline
$\widetilde{\nu}_{\mu,L}$ & muon-sneutrino & 56 \\\hline
$\widetilde{\tau}_L$ & stau 1 & 57 \\\hline
$\widetilde{\nu}_{\tau,L}$ & tau-sneutrino & 58 \\\hline
$\widetilde{e}_R$ & selectron 2 & 59 \\\hline
$\widetilde{\mu}_R$ & smuon 2 & 61 \\\hline
$\widetilde{\tau}_R$ & stau 2 & 63 \\\hline\hline
$\widetilde{g}$ & gluino & 64 \\\hline
$\widetilde{\chi}^0_1$ & neutralino 1 & 65 \\\hline
$\widetilde{\chi}^0_2$ & neutralino 2 & 66 \\\hline
$\widetilde{\chi}^0_3$ & neutralino 3 & 67 \\\hline
$\widetilde{\chi}^0_4$ & neutralino 4 & 68 \\\hline
$\widetilde{\chi}^+_1$ & chargino 1 & 69 \\\hline
$\widetilde{\chi}^+_2$ & chargino 2 & 70 \\\hline\hline
\end{tabular}
\end{center} *)
let pdg_mw = function
| L g when g > 0 -> 9 + 2*g
| L g -> - 9 + 2*g
| N g when g > 0 -> 10 + 2*g
| N g -> - 10 + 2*g
| U g when g > 0 -> 2*g
| U g -> 2*g
| D g when g > 0 -> - 1 + 2*g
| D g -> 1 + 2*g
| Gl -> 21 | Ga -> 22 | Z -> 23
| Wp -> 24 | Wm -> (-24)
| H_Light -> 25 | H_Heavy -> 35 | A -> 36
| Hp -> 37 | Hm -> (-37)
| Phip | Phim -> 27 | Phi0 -> 26
| Sup (M1,g) when g > 0 -> 40 + 2*g
| Sup (M1,g) -> - 40 + 2*g
| Sup (M2,g) when g > 0 -> 46 + 2*g
| Sup (M2,g) -> - 46 + 2*g
| Sdown (M1,g) when g > 0 -> 39 + 2*g
| Sdown (M1,g) -> - 39 + 2*g
| Sdown (M2,g) when g > 0 -> 45 + 2*g
| Sdown (M2,g) -> - 45 + 2*g
| Slepton (M1,g) when g > 0 -> 51 + 2*g
| Slepton (M1,g) -> - 51 + 2*g
| Slepton (M2,g) when g > 0 -> 57 + 2*g
| Slepton (M2,g) -> - 57 + 2*g
| Sneutrino g when g > 0 -> 52 + 2*g
| Sneutrino g -> - 52 + 2*g
| Grino -> 39
| Gluino -> 64
| Chargino C1 -> 69 | Chargino C1c -> (-69)
| Chargino C2 -> 70 | Chargino C2c -> (-70)
| Neutralino N1 -> 65 | Neutralino N2 -> 66
| Neutralino N3 -> 67 | Neutralino N4 -> 68
let mass_symbol f =
"mass(" ^ string_of_int (abs (pdg_mw f)) ^ ")"
let width_symbol f =
"width(" ^ string_of_int (abs (pdg_mw f)) ^ ")"
let conj_symbol = function
| false, str -> str
| true, str -> str ^ "_c"
let constant_symbol = function
| Unit -> "unit" | Pi -> "PI"
| Alpha_QED -> "alpha" | E -> "e" | G -> "g" | Vev -> "vev"
| Sin2thw -> "sin2thw" | Eidelta -> "eidelta" | Mu -> "mu" | G_Z -> "gz"
| Sin a -> "sin" ^ string_of_angle a | Cos a -> "cos" ^ string_of_angle a
| Sin2am2b -> "sin2am2b" | Cos2am2b -> "cos2am2b" | Sinamb -> "sinamb"
| Sinapb -> "sinapb" | Cosamb -> "cosamb" | Cosapb -> "cosapb"
| Cos4be -> "cos4be" | Sin4be -> "sin4be" | Sin4al -> "sin4al"
| Sin2al -> "sin2al" | Cos2al -> "cos2al" | Sin2be -> "sin2be"
| Cos2be -> "cos2be" | Tana -> "tana" | Tanb -> "tanb"
| Q_lepton -> "qlep" | Q_up -> "qup" | Q_down -> "qdwn"
| Q_charg -> "qchar"
| V_CKM (g1,g2) -> "vckm_" ^ string_of_int g1 ^ string_of_int g2
| M_SF (f,g,m1,m2) -> "mix_" ^ string_of_sff f ^ string_of_int g
^ string_of_sfm m1 ^ string_of_sfm m2
| AL g -> "al_" ^ string_of_int g
| AD g -> "ad_" ^ string_of_int g
| AU g -> "au_" ^ string_of_int g
| A_0 (n1,n2) -> "a0_" ^ string_of_neu n1 ^ string_of_neu n2
| A_P (c1,c2) -> "ap_" ^ string_of_char c1 ^ string_of_char c2
| V_0 (n1,n2) -> "v0_" ^ string_of_neu n1 ^ string_of_neu n2
| V_P (c1,c2) -> "vp_" ^ string_of_char c1 ^ string_of_char c2
| M_N (n1,n2) -> "mn_" ^ string_of_neu n1 ^ string_of_neu n2
| M_U (c1,c2) -> "mu_" ^ string_of_char c1 ^ string_of_char c2
| M_V (c1,c2) -> "mv_" ^ string_of_char c1 ^ string_of_char c2
| L_NC (n,c) -> "lnc_" ^ string_of_neu n ^ string_of_char c
| R_NC (n,c) -> "rnc_" ^ string_of_neu n ^ string_of_char c
| L_CN (c,n) -> "lcn_" ^ string_of_char c ^ string_of_neu n
| R_CN (c,n) -> "rcn_" ^ string_of_char c ^ string_of_neu n
| L_NCH (n,c) -> "lnch_" ^ string_of_neu n ^ string_of_char c
| R_NCH (n,c) -> "rnch_" ^ string_of_neu n ^ string_of_char c
| L_CNG (c,n) -> "lcng_" ^ string_of_char c ^ string_of_neu n
| R_CNG (c,n) -> "rcng_" ^ string_of_char c ^ string_of_neu n
| S_NNA (n1,n2) -> "snna_" ^ string_of_neu n1 ^ string_of_neu n2
| P_NNA (n1,n2) -> "pnna_" ^ string_of_neu n1 ^ string_of_neu n2
| S_NNG (n1,n2) -> "snng_" ^ string_of_neu n1 ^ string_of_neu n2
| P_NNG (n1,n2) -> "pnng_" ^ string_of_neu n1 ^ string_of_neu n2
| S_NNH1 (n1,n2) -> "snnh1_" ^ string_of_neu n1 ^ string_of_neu n2
| P_NNH1 (n1,n2) -> "pnnh1_" ^ string_of_neu n1 ^ string_of_neu n2
| S_NNH2 (n1,n2) -> "snnh2_" ^ string_of_neu n1 ^ string_of_neu n2
| P_NNH2 (n1,n2) -> "pnnh2_" ^ string_of_neu n1 ^ string_of_neu n2
| G_NC_lepton -> "gnclep" | G_NC_neutrino -> "gncneu"
| G_NC_up -> "gncup" | G_NC_down -> "gncdwn"
| G_CC -> "gcc"
| G_CCQ (vc,g1,g2) -> conj_symbol (vc, "gccq_" ^ string_of_int g1 ^ "_"
^ string_of_int g2)
| I_Q_W -> "iqw" | I_G_ZWW -> "igzww"
| G_WWWW -> "gw4" | G_ZZWW -> "gzzww"
| G_PZWW -> "gpzww" | G_PPWW -> "gppww"
| G_GH 1 -> "ghaw"
| G_GH 2 -> "gh1az" | G_GH 3 -> "gh2az"
| G_GH 4 -> "gh1ww" | G_GH 5 -> "gh2ww"
| G_GH 6 -> "ghh1w" | G_GH 7 -> "ghh2w"
| G_GH 8 -> "gh1zz" | G_GH 9 -> "gh2zz"
| G_GH 10 -> "ghhz" | G_GH 11 -> "ghhp"
| G_GH _ -> failwith "this G_GH coupling is not available"
| G_GHGo n -> "g_hgh(" ^ string_of_int n ^ ")"
| G_GH4 1 -> "gaazz" | G_GH4 2 -> "gh1h1zz" | G_GH4 3 -> "gh2h2zz"
| G_GH4 4 -> "ghphmzz" | G_GH4 5 -> "ghphmpp" | G_GH4 6 -> "ghphmpz"
| G_GH4 7 -> "ghh1wz" | G_GH4 8 -> "ghh2wz"
| G_GH4 9 -> "ghh1wp" | G_GH4 10 -> "ghh2wp"
| G_GH4 11 -> "gaaww" | G_GH4 12 -> "gh1h1ww" | G_GH4 13 -> "gh2h2ww"
| G_GH4 14 -> "ghhww" | G_GH4 15 -> "ghawz" | G_GH4 16 -> "ghawp"
| G_GH4 _ -> failwith "this G_GH4 coupling is not available"
| G_CICIH1 (n1,n2) -> "gcicih1_" ^ string_of_neu n1 ^ "_"
^ string_of_neu n2
| G_CICIH2 (n1,n2) -> "gcicih2_" ^ string_of_neu n1 ^ "_"
^ string_of_neu n2
| G_CICIA (n1,n2) -> "gcicia_" ^ string_of_neu n1 ^ "_"
^ string_of_neu n2
| G_CICIG (n1,n2) -> "gcicig_" ^ string_of_neu n1 ^ "_"
^ string_of_neu n2
| G_H3 n -> "gh3_" ^ string_of_int n
| G_H4 n -> "gh4_" ^ string_of_int n
| G_HGo3 n -> "ghg3_" ^ string_of_int n
| G_HGo4 n -> "ghg4_" ^ string_of_int n
| G_GG4 n -> "ggg4_" ^ string_of_int n
| G_strong -> "gs" | G_SS -> "gs**2"
| Gs -> "gs"
| I_G_S -> "igs"
| G_S_Sqrt -> "gssq"
| G_NWC (n,c) -> "gnwc_" ^ string_of_neu n ^ "_" ^ string_of_char c
| G_CWN (c,n) -> "gcwn_" ^ string_of_char c ^ "_" ^ string_of_neu n
| G_CH1C (c1,c2) -> "gch1c_" ^ string_of_char c1 ^ "_" ^ string_of_char c2
| G_CH2C (c1,c2) -> "gch2c_" ^ string_of_char c1 ^ "_" ^ string_of_char c2
| G_CAC (c1,c2) -> "gcac_" ^ string_of_char c1 ^ "_" ^ string_of_char c2
| G_CGC (c1,c2) -> "gcgc_" ^ string_of_char c1 ^ "_" ^ string_of_char c2
| G_YUK (i,g) -> "g_yuk" ^ string_of_int i ^ "_" ^ string_of_int g
| G_NZN (n1,n2) -> "gnzn_" ^ string_of_neu n1 ^ "_" ^ string_of_neu n2
| G_CZC (c1,c2) -> "gczc_" ^ string_of_char c1 ^ "_" ^ string_of_char
c2
| G_YUK_1 (n,m) -> "g_yuk1_" ^ string_of_int n ^ "_" ^ string_of_int m
| G_YUK_2 (n,m) -> "g_yuk2_" ^ string_of_int n ^ "_" ^ string_of_int m
| G_YUK_3 (n,m) -> "g_yuk3_" ^ string_of_int n ^ "_" ^ string_of_int m
| G_YUK_4 (n,m) -> "g_yuk4_" ^ string_of_int n ^ "_" ^ string_of_int m
| G_YUK_C (vc,g,c,sf,m) -> conj_symbol (vc, "g_yuk_ch" ^ string_of_char c
^ "_" ^ string_of_sff sf ^ string_of_sfm m ^ "_" ^ string_of_int g )
| G_YUK_N (vc,g,n,sf,m) -> conj_symbol (vc, "g_yuk_n" ^ string_of_neu n
^ "_" ^ string_of_sff sf ^ string_of_sfm m ^ "_" ^ string_of_int g )
| G_YUK_G (vc,g,sf,m) -> conj_symbol (vc, "g_yuk_g" ^ string_of_sff sf
^ string_of_sfm m ^ "_" ^ string_of_int g)
| G_YUK_Q (vc,g1,g2,c,sf,m) -> conj_symbol (vc, "g_yuk_ch" ^ string_of_char c
^ "_" ^ string_of_sff sf ^ string_of_sfm m ^ "_" ^ string_of_int g1
^ "_" ^ string_of_int g2)
| G_NHC (n,c) -> "g_nhc_" ^ string_of_neu n ^ "_" ^ string_of_char c
| G_CHN (c,n) -> "g_chn_" ^ string_of_neu n ^ "_" ^ string_of_char c
| G_NGC (n,c) -> "g_ngc_" ^ string_of_neu n ^ string_of_char c
| G_CGN (c,n) -> "g_cgn_" ^ string_of_char c ^ string_of_neu n
| SUM_1 -> "sum1"
| G_SLSNW (vc,g,m) -> conj_symbol (vc, "gsl" ^ string_of_sfm m ^ "_"
^ string_of_int g ^ "snw")
| G_ZSF (f,g,m1,m2) -> "g" ^ string_of_sff f ^ string_of_sfm m1 ^ "z"
^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g
| G_WWSFSF (f,g,m1,m2) -> "gww" ^ string_of_sff f ^ string_of_sfm m1
^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g
| G_WPSLSN (vc,g,m) -> conj_symbol (vc, "gpwsl" ^ string_of_sfm m
^ "sn_" ^ string_of_int g)
| G_WZSLSN (vc,g,m) -> conj_symbol (vc, "gwzsl" ^ string_of_sfm m
^ "sn_" ^ string_of_int g)
| G_H1SFSF (f,g,m1,m2) -> "gh1" ^ string_of_sff f ^ string_of_sfm m1
^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g
| G_H2SFSF (f,g,m1,m2) -> "gh2" ^ string_of_sff f ^ string_of_sfm m1
^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g
| G_ASFSF (f,g,m1,m2) -> "ga" ^ string_of_sff f ^ string_of_sfm m1
^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g
| G_HSNSL (vc,g,m) -> conj_symbol (vc, "ghsnsl" ^ string_of_sfm m ^ "_"
^ string_of_int g)
| G_GoSFSF (f,g,m1,m2) -> "ggo" ^ string_of_sff f ^ string_of_sfm m1
^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g
| G_GoSNSL (vc,g,m) -> conj_symbol (vc, "ggosnsl" ^ string_of_sfm m ^ "_"
^ string_of_int g)
| G_HSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "ghsu" ^ string_of_sfm m1
^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_"
^ string_of_int g2)
| G_GSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "ggsu" ^ string_of_sfm m1
^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_"
^ string_of_int g2)
| G_WPSUSD (vc,m1,m2,n,m) -> conj_symbol (vc, "gpwpsu" ^ string_of_sfm m1
^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int n ^ "_"
^ string_of_int m)
| G_WZSUSD (vc,m1,m2,n,m) -> conj_symbol (vc, "gzwpsu" ^ string_of_sfm m1
^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int n ^ "_"
^ string_of_int m)
| G_SWS (vc,g1,g2,m1,m2) -> conj_symbol (vc, "gs" ^ string_of_sfm m1 ^ "ws"
^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_" ^ string_of_int g2)
| G_GlGlSQSQ -> "gglglsqsq"
| G_PPSFSF f -> "gpp" ^ string_of_sff f ^ string_of_sff f
| G_ZZSFSF (f,g,m1,m2) -> "gzz" ^ string_of_sff f ^ string_of_sfm m1
^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g
| G_ZPSFSF (f,g,m1,m2) -> "gzp" ^ string_of_sff f ^ string_of_sfm m1
^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g
| G_GlPSQSQ -> "gglpsqsq"
| G_GlZSFSF (f,g,m1,m2) -> "ggl" ^ string_of_sff f ^ string_of_sfm m1
^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int g
| G_GlWSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "gglwsu"
^ string_of_sfm m1 ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1
^ "_" ^ string_of_int g2)
| G_GHGo4 1 -> "gzzg0g0" | G_GHGo4 2 -> "gzzgpgm"
| G_GHGo4 3 -> "gppgpgm" | G_GHGo4 4 -> "gzpgpgm"
| G_GHGo4 5 -> "gwwgpgm" | G_GHGo4 6 -> "gwwg0g0"
| G_GHGo4 7 -> "gwzg0g" | G_GHGo4 8 -> "gwzg0g"
| G_GHGo4 9 -> "gwzh1g" | G_GHGo4 10 -> "gwzh2g"
| G_GHGo4 11 -> "gwph1g" | G_GHGo4 12 -> "gwph2g"
| G_GHGo4 _ -> failwith "Coupling G_GHGo4 is not available"
| G_HSF31 (h,g,m1,m2,f1,f2) -> "g_" ^ string_of_higgs h ^
string_of_int g ^ string_of_sfm m1 ^ string_of_sfm m2 ^
string_of_sff f1 ^ string_of_sff f2
| G_HSF32 (h,g1,g2,m1,m2,f1,f2) -> "g_" ^ string_of_higgs h ^
string_of_int g1 ^ "_" ^ string_of_int g2 ^ string_of_sfm m1 ^
string_of_sfm m2 ^ string_of_sff f1 ^ string_of_sff f2
| G_HSF41 (h,g,m1,m2,f1,f2) -> "g_" ^ string_of_higgs h ^
string_of_int g ^ string_of_sfm m1 ^ string_of_sfm m2 ^
string_of_sff f1 ^ string_of_sff f2
| G_HSF42 (h,g1,g2,m1,m2,f1,f2) -> "g_" ^ string_of_higgs h ^
string_of_int g1 ^ "_" ^ string_of_int g2 ^ string_of_sfm m1 ^
string_of_sfm m2 ^ string_of_sff f1 ^ string_of_sff f2
| G_H1H1SFSF (f,m1,m2,n) -> "gh1h1" ^ string_of_sff f ^ string_of_sfm
m1 ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n
| G_H1H2SFSF (f,m1,m2,n) -> "gh1h2" ^ string_of_sff f ^ string_of_sfm
m1 ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n
| G_H2H2SFSF (f,m1,m2,n) -> "gh2h2" ^ string_of_sff f ^ string_of_sfm
m1 ^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n
| G_HHSFSF (f,m1,m2,n) -> "ghh" ^ string_of_sff f ^ string_of_sfm m1
^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n
| G_AASFSF (f,m1,m2,n) -> "gaa" ^ string_of_sff f ^ string_of_sfm m1
^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n
| G_HH1SUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "ghh1su"
^ string_of_sfm m1 ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1
^ "_" ^ string_of_int g2)
| G_HH2SUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "ghh2su"
^ string_of_sfm m1 ^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1
^ "_" ^ string_of_int g2)
| G_HASUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "ghasu"
^ string_of_sfm m1 ^ "sd" ^ string_of_sfm m2 ^ "_"
^ string_of_int g1 ^ "_" ^ string_of_int g2 ^ "_c")
| G_HH1SLSN (vc,m,g) -> conj_symbol (vc, "ghh1sl" ^ string_of_sfm m
^ "sn_" ^ string_of_int g)
| G_HH2SLSN (vc,m,g) -> conj_symbol (vc, "ghh2sl" ^ string_of_sfm m
^ "sn_" ^ string_of_int g)
| G_HASLSN (vc,m,g) -> conj_symbol (vc, "ghasl" ^ string_of_sfm m
^ "sn_" ^ string_of_int g)
| G_AG0SFSF (f,m1,m2,n) -> "gag0" ^ string_of_sff f ^ string_of_sfm m1
^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n
| G_HGSFSF (f,m1,m2,n) -> "ghg" ^ string_of_sff f ^ string_of_sfm m1
^ string_of_sff f ^ string_of_sfm m1 ^ "_" ^ string_of_int n
| G_GGSFSF (f,m1,m2,n) -> "ggg" ^ string_of_sff f ^ string_of_sfm m1
^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n
| G_G0G0SFSF (f,m1,m2,n) -> "gg0g0" ^ string_of_sff f ^ string_of_sfm m1
^ string_of_sff f ^ string_of_sfm m2 ^ "_" ^ string_of_int n
| G_HGSNSL (vc,m,n) -> conj_symbol (vc, "ghgsnsl" ^ string_of_sfm m ^ "_"
^ string_of_int n)
| G_H1GSNSL (vc,m,n) -> conj_symbol (vc, "gh1gsnsl" ^ string_of_sfm m ^ "_"
^ string_of_int n)
| G_H2GSNSL (vc,m,n) -> conj_symbol (vc, "gh2gsnsl" ^ string_of_sfm m ^ "_"
^ string_of_int n)
| G_AGSNSL (vc,m,n) -> conj_symbol (vc, "gagsnsl" ^ string_of_sfm m ^ "_"
^ string_of_int n)
| G_GGSNSL (vc,m,n) -> conj_symbol (vc, "gggsnsl" ^ string_of_sfm m ^ "_"
^ string_of_int n)
| G_HGSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "gghpsu" ^ string_of_sfm m1
^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_"
^ string_of_int g2)
| G_H1GSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "gh1gpsu" ^ string_of_sfm m1
^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_"
^ string_of_int g2)
| G_H2GSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "gh2gpsu" ^ string_of_sfm m1
^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_"
^ string_of_int g2)
| G_AGSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "gagpsu" ^ string_of_sfm m1
^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_"
^ string_of_int g2)
| G_GGSUSD (vc,m1,m2,g1,g2) -> conj_symbol (vc, "gggpsu" ^ string_of_sfm m1
^ "sd" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1 ^ "_"
^ string_of_int g2)
| G_SN4 (g1,g2) -> "gsn4_" ^ string_of_int g1 ^ "_" ^ string_of_int g2
| G_SN2SL2_1 (m1,m2,g1,g2) -> "gsl_" ^ string_of_int g1 ^ "_sl_"
^ string_of_int g1 ^ "_sl" ^ string_of_sfm m1 ^ "_" ^ string_of_int g2
^ "_sl" ^ string_of_sfm m2 ^ "_" ^ string_of_int g2
| G_SN2SL2_2 (m1,m2,g1,g2) -> "gsl_" ^ string_of_int g1 ^ "_sl_"
^ string_of_int g2 ^ "_sl" ^ string_of_sfm m1 ^ "_" ^ string_of_int g1
^ "_sl" ^ string_of_sfm m2 ^ "_" ^ string_of_int g2 ^ "_mix"
| G_SF4 (f1,f2,m1,m2,m3,m4,g1,g2) -> "gsf" ^ string_of_sff f1 ^
string_of_sff f2 ^ string_of_sfm m1 ^ string_of_sfm m2 ^
string_of_sfm m3 ^ string_of_sfm m4 ^ string_of_int g1 ^
string_of_int g2
| G_SF4_3 (f1,f2,m1,m2,m3,m4,g1,g2,g3) -> "gsf" ^ string_of_sff f1 ^
string_of_sff f2 ^ string_of_sfm m1 ^ string_of_sfm m2 ^
string_of_sfm m3 ^ string_of_sfm m4 ^ string_of_int g1 ^
string_of_int g2 ^ "_" ^ string_of_int g3
| G_SF4_4 (f1,f2,m1,m2,m3,m4,g1,g2,g3,g4) -> "gsf" ^ string_of_sff f1 ^
string_of_sff f2 ^ string_of_sfm m1 ^ string_of_sfm m2 ^
string_of_sfm m3 ^ string_of_sfm m4 ^ string_of_int g1 ^ "_" ^
string_of_int g2 ^ string_of_int g3 ^ "_" ^ string_of_int g4
| G_SL4 (m1,m2,m3,m4,g) -> "gsl" ^ string_of_sfm m1 ^ "_"
^ "sl" ^ string_of_sfm m2 ^ "_" ^ "sl" ^ string_of_sfm m3 ^ "_"
^ "sl" ^ string_of_sfm m4 ^ "_" ^ string_of_int g
| G_SL4_2 (m1,m2,m3,m4,g1,g2) -> "gsl" ^ string_of_sfm m1 ^ "_"
^ "sl" ^ string_of_sfm m2 ^ "_" ^ "sl" ^ string_of_sfm m3 ^ "_"
^ "sl" ^ string_of_sfm m4 ^ "_" ^ string_of_int g1 ^ "_" ^
string_of_int g2
| G_SN2SQ2 (f,m1,m2,g1,g2) -> "gsn_" ^ string_of_int g1 ^ "_sn_"
^ string_of_int g1 ^ "_" ^ string_of_sff f ^ string_of_sfm m1 ^ "_"
^ string_of_int g2 ^ "_" ^ string_of_sff f ^ string_of_sfm m2 ^ "_"
^ string_of_int g2
| G_SL2SQ2 (f,m1,m2,m3,m4,g1,g2) -> "gsl" ^ string_of_sfm m1 ^ "_"
^ string_of_int g1 ^ "_sl" ^ string_of_sfm m2 ^ "_" ^ string_of_int g1
^ "_" ^ string_of_sff f ^ string_of_sfm m3 ^ "_" ^ string_of_int g2
^ "_" ^ string_of_sff f ^ string_of_sfm m4 ^ "_" ^ string_of_int g2
| G_SUSDSNSL (vc,m1,m2,m3,g1,g2,g3) -> conj_symbol (vc, "gsl"
^ string_of_sfm m3 ^ "_" ^ string_of_int g3 ^ "_sn_" ^ string_of_int g3
^ "_su" ^ string_of_sfm m1 ^ "_" ^ string_of_int g1 ^ "_sd"
^ string_of_sfm m2 ^ "_" ^ string_of_int g2)
| G_SU4 (m1,m2,m3,m4,g) -> "gsu" ^ string_of_sfm m1 ^ "_"
^ "_su" ^ string_of_sfm m2 ^ "_" ^ "_su" ^ string_of_sfm m3 ^ "_" ^
"_su" ^ string_of_sfm m4 ^ "_" ^ string_of_int g
| G_SU4_2 (m1,m2,m3,m4,g1,g2) -> "gsu" ^ string_of_sfm m1 ^ "_"
^ "_su" ^ string_of_sfm m2 ^ "_" ^ "_su" ^ string_of_sfm m3 ^ "_" ^
"_su" ^ string_of_sfm m4 ^ "_" ^ string_of_int g1 ^ "_" ^
string_of_int g2
| G_SD4 (m1,m2,m3,m4,g) -> "gsd" ^ string_of_sfm m1 ^ "_"
^ "_sd" ^ string_of_sfm m2 ^ "_" ^ "_sd" ^ string_of_sfm m3 ^ "_"
^ "_sd" ^ string_of_sfm m4 ^ "_" ^ string_of_int g
| G_SD4_2 (m1,m2,m3,m4,g1,g2) -> "gsd" ^ string_of_sfm m1 ^ "_"
^ "_sd" ^ string_of_sfm m2 ^ "_" ^ "_sd" ^ string_of_sfm m3 ^ "_"
^ "_sd" ^ string_of_sfm m4 ^ "_" ^ string_of_int g1 ^ "_" ^
string_of_int g2
| G_SU2SD2 (m1,m2,m3,m4,g1,g2,g3,g4) -> "gsu" ^ string_of_sfm m1
^ "_" ^ string_of_int g1 ^ "_su" ^ string_of_sfm m2 ^ "_"
^ string_of_int g2 ^ "_sd" ^ string_of_sfm m3 ^ "_" ^ string_of_int g3
^ "_sd" ^ string_of_sfm m4 ^ "_" ^ string_of_int g4
| M f -> "mass" ^ flavor_symbol f
| W f -> "width" ^ flavor_symbol f
| G_Grav -> "ggrav" | G_Gr_Ch C1 -> "ggrch1" | G_Gr_Ch C2 -> "ggrch2"
| G_Gr_Ch C1c -> "ggrch1c" | G_Gr_Ch C2c -> "ggrch2c"
| G_Gr_Z_Neu n -> "ggrzneu" ^ string_of_neu n
| G_Gr_A_Neu n -> "ggraneu" ^ string_of_neu n
| G_Gr4_Neu n -> "ggr4neu" ^ string_of_neu n
| G_Gr4_A_Ch C1 -> "ggr4ach1" | G_Gr4_A_Ch C2 -> "ggr4ach2"
| G_Gr4_A_Ch C1c -> "ggr4ach1c" | G_Gr4_A_Ch C2c -> "ggr4ach2c"
| G_Gr4_Z_Ch C1 -> "ggr4zch1" | G_Gr4_Z_Ch C2 -> "ggr4zch2"
| G_Gr4_Z_Ch C1c -> "ggr4zch1c" | G_Gr4_Z_Ch C2c -> "ggr4zch2c"
| G_Grav_N -> "ggravn"
| G_GravGl -> "gs * ggrav"
| G_Grav_L (g,m) -> "ggravl" ^ string_of_int g ^ string_of_sfm m
| G_Grav_Lc (g,m) -> "ggravl" ^ string_of_int g ^ string_of_sfm m ^ "c"
| G_Grav_U (g,m) -> "ggravu" ^ string_of_int g ^ string_of_sfm m
| G_Grav_Uc (g,m) -> "ggravu" ^ string_of_int g ^ string_of_sfm m ^ "c"
| G_Grav_D (g,m) -> "ggravd" ^ string_of_int g ^ string_of_sfm m
| G_Grav_Dc (g,m) -> "ggravd" ^ string_of_int g ^ string_of_sfm m ^ "c"
| G_Gr_H_Ch C1 -> "ggrhch1" | G_Gr_H_Ch C2 -> "ggrhch2"
| G_Gr_H_Ch C1c -> "ggrhch1c" | G_Gr_H_Ch C2c -> "ggrhch2c"
| G_Gr_H1_Neu n -> "ggrh1neu" ^ string_of_neu n
| G_Gr_H2_Neu n -> "ggrh2neu" ^ string_of_neu n
| G_Gr_H3_Neu n -> "ggrh3neu" ^ string_of_neu n
| G_Gr4A_Sl (g,m) -> "ggr4asl" ^ string_of_int g ^ string_of_sfm m
| G_Gr4A_Slc (g,m) -> "ggr4asl" ^ string_of_int g ^ string_of_sfm m ^ "c"
| G_Gr4A_Su (g,m) -> "ggr4asu" ^ string_of_int g ^ string_of_sfm m
| G_Gr4A_Suc (g,m) -> "ggr4asu" ^ string_of_int g ^ string_of_sfm m ^ "c"
| G_Gr4A_Sd (g,m) -> "ggr4asd" ^ string_of_int g ^ string_of_sfm m
| G_Gr4A_Sdc (g,m) -> "ggr4asd" ^ string_of_int g ^ string_of_sfm m ^ "c"
| G_Gr4Z_Sn -> "ggr4zsn" | G_Gr4Z_Snc -> "ggr4zsnc"
| G_Gr4Z_Sl (g,m) -> "ggr4zsl" ^ string_of_int g ^ string_of_sfm m
| G_Gr4Z_Slc (g,m) -> "ggr4zsl" ^ string_of_int g ^ string_of_sfm m ^ "c"
| G_Gr4Z_Su (g,m) -> "ggr4zsu" ^ string_of_int g ^ string_of_sfm m
| G_Gr4Z_Suc (g,m) -> "ggr4zsu" ^ string_of_int g ^ string_of_sfm m ^ "c"
| G_Gr4Z_Sd (g,m) -> "ggr4zsd" ^ string_of_int g ^ string_of_sfm m
| G_Gr4Z_Sdc (g,m) -> "ggr4zsd" ^ string_of_int g ^ string_of_sfm m ^ "c"
| G_Gr4W_Sl (g,m) -> "ggr4wsl" ^ string_of_int g ^ string_of_sfm m
| G_Gr4W_Slc (g,m) -> "ggr4wsl" ^ string_of_int g ^ string_of_sfm m ^ "c"
| G_Gr4W_Su (g,m) -> "ggr4wsu" ^ string_of_int g ^ string_of_sfm m
| G_Gr4W_Suc (g,m) -> "ggr4wsu" ^ string_of_int g ^ string_of_sfm m ^ "c"
| G_Gr4W_Sd (g,m) -> "ggr4wsd" ^ string_of_int g ^ string_of_sfm m
| G_Gr4W_Sdc (g,m) -> "ggr4wsd" ^ string_of_int g ^ string_of_sfm m ^ "c"
| G_Gr4Gl_Su (g,m) -> "ggr4glsu" ^ string_of_int g ^ string_of_sfm m
| G_Gr4Gl_Suc (g,m) -> "ggr4glsu" ^ string_of_int g ^ string_of_sfm m ^ "c"
| G_Gr4Gl_Sd (g,m) -> "ggr4glsd" ^ string_of_int g ^ string_of_sfm m
| G_Gr4Gl_Sdc (g,m) -> "ggr4glsd" ^ string_of_int g ^ string_of_sfm m ^ "c"
| G_Gr4_Z_H1 n -> "ggr4zh1_" ^ string_of_neu n
| G_Gr4_Z_H2 n -> "ggr4zh2_" ^ string_of_neu n
| G_Gr4_Z_H3 n -> "ggr4zh3_" ^ string_of_neu n
| G_Gr4_W_H n -> "ggr4wh_" ^ string_of_neu n
| G_Gr4_W_Hc n -> "ggr4whc_" ^ string_of_neu n
| G_Gr4_H_A C1 -> "ggr4ha1" | G_Gr4_H_A C2 -> "ggr4ha2"
| G_Gr4_H_A C1c -> "ggr4ha1c" | G_Gr4_H_A C2c -> "ggr4ha2c"
| G_Gr4_H_Z C1 -> "ggr4hz1" | G_Gr4_H_Z C2 -> "ggr4hz2"
| G_Gr4_H_Z C1c -> "ggr4hz1c" | G_Gr4_H_Z C2c -> "ggr4hz2c"
| G_Gr4W_Sn -> "ggr4wsn"
| G_Gr4W_Snc -> "ggr4wsnc"
end
(*i
* Local Variables:
* mode:caml
* indent-tabs-mode:nil
* page-delimiter:"^(\\* .*\n"
* End:
i*)
Index: trunk/src/omega/src/modellib_SM.mli
===================================================================
--- trunk/src/omega/src/modellib_SM.mli (revision 2698)
+++ trunk/src/omega/src/modellib_SM.mli (revision 2699)
@@ -1,62 +1,62 @@
(* $Id$
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. *)
(* \thocwmodulesection{Hardcoded Models} *)
module Phi3 : Model.T with module Ch = Charges.Null
module Phi4 : Model.T with module Ch = Charges.Null
-module QED : Model.T with module Ch = Charges.Z
+module QED : Model.T with module Ch = Charges.ZZ
module QCD : Model.T with module Ch = Charges.ZZ
module type SM_flags =
sig
val higgs_triangle : bool (* $H\gamma\gamma$, $Hg\gamma$ and $Hgg couplings *)
val triple_anom : bool
val quartic_anom : bool
val higgs_anom : bool
val k_matrix : bool
val ckm_present : bool
end
module SM_no_anomalous : SM_flags
module SM_anomalous : SM_flags
module SM_k_matrix : SM_flags
module SM_no_anomalous_ckm : SM_flags
module SM_anomalous_ckm : SM_flags
module SM_Hgg : SM_flags
module SM3 : functor (F : SM_flags) -> Model.Gauge with module Ch = Charges.QQ
module SM : functor (F : SM_flags) -> Model.Gauge with module Ch = Charges.QQ
module SM_Rxi : Model.T with module Ch = Charges.QQ
module Groves : functor (M : Model.Gauge) -> Model.Gauge with module Ch = M.Ch
module SM_clones : Model.Gauge with module Ch = Charges.QQ
module SM3_clones : Model.Gauge with module Ch = Charges.QQ
(*i
* Local Variables:
* mode:caml
* indent-tabs-mode:nil
* page-delimiter:"^(\\* .*\n"
* End:
i*)

File Metadata

Mime Type
text/x-diff
Expires
Wed, May 14, 10:34 AM (1 d, 11 h)
Storage Engine
blob
Storage Format
Raw Data
Storage Handle
5111191
Default Alt Text
(409 KB)

Event Timeline