Page MenuHomeHEPForge
Files F7877118

No OneTemporary
Actions

View Options

This file is larger than 256 KB, so syntax highlighting was skipped.
Index: trunk/src/models/parameters.SM_ac.f90
===================================================================
--- trunk/src/models/parameters.SM_ac.f90 (revision 3998)
+++ trunk/src/models/parameters.SM_ac.f90 (revision 3999)
@@ -1,325 +1,321 @@
! $Id: parameters.SM_ac.f90,v 1.4 2006/06/16 13:31:48 kilian Exp $
!
! Copyright (C) 1999-2012 by
! Wolfgang Kilian <kilian@physik.uni-siegen.de>
! Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
! Juergen Reuter <juergen.reuter@desy.de>
! Christian Speckner <christian.speckner@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_sm_ac
use kinds
use constants
use sm_physics !NODEP!
implicit none
private
real(default), dimension(27), public :: mass, width
real(default), public :: as
complex(default), public :: gs, igs
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, ghmm, &
iqw, igzww, igwww, gw4, gzzww, gazww, gaaww
real(default), public :: vev
complex(default), dimension(2), public :: &
gncneu, gnclep, gncup, gncdwn
real(default), public :: a4 = 0, a5 = 0, a6 = 0, a7 = 0, a10 = 0
real(default), public :: tau4, tau5
complex(default), public :: ig1a, ig1z, rg5a, rg5z, &
ig1pkpg4a, ig1pkpg4z, ig1pkmg4a, ig1pkmg4z, &
ig1mkpg4a, ig1mkpg4z, ig1mkmg4a, ig1mkmg4z, &
ila, ilz, il5a, il5z, ik5a, ik5z, &
alww0, alww2, alzw0, alzw1, alzz
complex(default), private :: ghgaga_sm, ghgaz_sm
complex(default), public :: ghgaga_ac, ghgaz_ac, ghzz_ac, ghww_ac
complex(default), public :: ghgaz_u, ghzz_u, ghww_u
complex(default), public :: lambda_h, fw, fww, fb, fbb
complex(default), private :: h_anom
public :: import_from_whizard, model_update_alpha_s
contains
subroutine import_from_whizard (par_array)
real(default), dimension(52), 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) :: xi0
real(default) :: xipm
real(default) :: a4
real(default) :: a5
real(default) :: a6
real(default) :: a7
real(default) :: a10
real(default) :: g1a
real(default) :: g1z
real(default) :: g4a
real(default) :: g4z
real(default) :: g5a
real(default) :: g5z
real(default) :: ka
real(default) :: kz
real(default) :: la
real(default) :: lz
real(default) :: k5a
real(default) :: k5z
real(default) :: l5a
real(default) :: l5z
real(default) :: v
real(default) :: cw
real(default) :: sw
real(default) :: ee
real(default) :: az
real(default) :: awz1
real(default) :: awz2
real(default) :: fac_gh3
real(default) :: fghgaga
real(default) :: fghgaz
real(default) :: lambdah
real(default) :: fw
real(default) :: fww
real(default) :: fb
real(default) :: fbb
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%xi0 = par_array(17)
par%xipm = par_array(18)
par%a4 = par_array(19)
par%a5 = par_array(20)
par%a6 = par_array(21)
par%a7 = par_array(22)
par%a10 = par_array(23)
par%g1a = par_array(24)
par%g1z = par_array(25)
par%g4a = par_array(26)
par%g4z = par_array(27)
par%g5a = par_array(28)
par%g5z = par_array(29)
par%ka = par_array(30)
par%kz = par_array(31)
par%la = par_array(32)
par%lz = par_array(33)
par%k5a = par_array(34)
par%k5z = par_array(35)
par%l5a = par_array(36)
par%l5z = par_array(37)
par%fac_gh3 = par_array(38)
par%fghgaga = par_array(39)
par%fghgaz = par_array(40)
par%lambdah = par_array(41)
par%fw = par_array(42)
par%fww = par_array(43)
par%fb = par_array(44)
par%fbb = par_array(45)
par%v = par_array(46)
par%cw = par_array(47)
par%sw = par_array(48)
par%ee = par_array(49)
par%aZ = par_array(50)
par%aWZ1 = par_array(51)
par%aWZ2 = par_array(52)
mass(1:27) = 0
width(1:27) = 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
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 = par%sw**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
ghhww = g**2 / 2.0_default
ghzz = mass(23) * g / costhw
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 = - par%fac_gh3 * 3 * mass(25)**2 / vev
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
a4 = par%a4
a5 = par%a5
a6 = par%a6
a7 = par%a7
a10 = par%a10
ig1a = iqw * par%g1a
ig1z = igzww * par%g1z
ig1pkpg4a = iqw * (par%g1a + par%ka + par%g4a) / 2
ig1pkpg4z = igzww * (par%g1z + par%kz + par%g4z) / 2
ig1pkmg4a = iqw * (par%g1a + par%ka - par%g4a) / 2
ig1pkmg4z = igzww * (par%g1z + par%kz - par%g4z) / 2
ig1mkpg4a = iqw * (par%g1a - par%ka + par%g4a) / 2
ig1mkpg4z = igzww * (par%g1z - par%kz + par%g4z) / 2
ig1mkmg4a = iqw * (par%g1a - par%ka - par%g4a) / 2
ig1mkmg4z = igzww * (par%g1z - par%kz - par%g4z) / 2
ila = iqw * par%la / (mass(24)*mass(24))
ilz = igzww * par%lz / (mass(24)*mass(24))
rg5a = qw * par%g5a
rg5z = gzww * par%g5z
ik5a = iqw * par%k5a
ik5z = igzww * par%k5z
il5a = iqw * par%l5a / (mass(24)*mass(24))
il5z = igzww * par%l5z / (mass(24)*mass(24))
alww0 = g**4 * (a4 + 2 * a5)
alww2 = g**4 * 2 * a4
alzw1 = g**4 / costhw**2 * (a4 + a6)
alzw0 = g**4 / costhw**2 * 2 * (a5 + a7)
alzz = g**4 / costhw**4 * 2 * (a4 + a5 + (a6+a7+a10)*2)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! Higgs anomaly couplings
!!! SM LO loop factor (top,bottom,W)
ghgaga_sm = (-1._default) * alpha / vev / 2.0_default / PI * &
(( 4.0_default * (fonehalf(ttop) + fonehalf(tch)) &
+ fonehalf(tbot)) / 3.0_default + fonehalf(ttau) + fone(tw))
!!! asymptotic limit:
!!! ghgaga = (par%ee)**2 / vev / &
!!! 9.0_default / pi**2
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! SM LO loop factor (only top and W)
ghgaz_sm = 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
h_anom = g * mass(25) / par%lambdah**2
- !!! JRR corrected this, 25.10.2012
ghgaga_ac = par%fghgaga * ghgaga_sm + 2.0_default * h_anom * &
sin2thw * (par%fbb + par%fww)
- !!!
- ghgaz_ac = par%fghgaz * ghgaz_sm + h_anom * &
+ ghgaz_ac = par%fghgaz * ghgaz_sm + 2.0_default * h_anom * &
sinthw * (sinthw**2 * par%fbb - costhw**2 * par%fww) / costhw
- !!! JRR corrected this, 25.10.2012
ghzz_ac = + 2.0_default * h_anom * (sinthw**4 * par%fbb + &
costhw**4 * par%fww) / costhw**2
ghww_ac = + 2.0_default * h_anom * par%fww
- !!!
- ghgaz_u = h_anom * sinthw * (par%fw - par%fb) / 2.0_default / costhw
- ghzz_u = h_anom * (costhw**2 * par%fw + sinthw**2 * par%fb) / &
+ ghgaz_u = - h_anom * sinthw * (par%fw - par%fb) / 2.0_default / costhw
+ ghzz_u = - h_anom * (costhw**2 * par%fw + sinthw**2 * par%fb) / &
2.0_default / costhw**2
- ghww_u = h_anom * par%fw / 2.0_default
+ ghww_u = - h_anom * par%fw / 2.0_default
end subroutine import_from_whizard
subroutine model_update_alpha_s (alpha_s)
real(default), intent(in) :: alpha_s
gs = sqrt(2.0_default*PI*alpha_s)
igs = cmplx(0.0_default, 1.0_default, kind=default) * gs
end subroutine model_update_alpha_s
end module parameters_sm_ac
Index: trunk/src/omega/src/targets.ml
===================================================================
--- trunk/src/omega/src/targets.ml (revision 3998)
+++ trunk/src/omega/src/targets.ml (revision 3999)
@@ -1,4084 +1,4095 @@
(* $Id$
Copyright (C) 1999-2012 by
Wolfgang Kilian <kilian@physik.uni-siegen.de>
Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
Christian Speckner <christian.speckner@physik.uni-freiburg.de>
Fabian Bach <fabian.bach@cern.ch> (only parts of this file)
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 "Targets" ["Code Generation"]
{ RCS.revision = "$Revision$";
RCS.date = "$Date$";
RCS.author = "$Author$";
RCS.source
= "$URL$" }
module Dummy (F : Fusion.Maker) (P : Momentum.T) (M : Model.T) =
struct
let rcs_list = []
type amplitudes = Fusion.Multi(F)(P)(M).amplitudes
type diagnostic = All | Arguments | Momenta | Gauge
let options = Options.empty
let amplitudes_to_channel cmdline oc amplitudes = failwith "Targets.Dummy"
let parameters_to_channel oc = failwith "Targets.Dummy"
end
(* \thocwmodulesection{\texttt{Fortran\,90/95}} *)
(* \thocwmodulesubsection{Dirac Fermions}
We factor out the code for fermions so that we can use the simpler
implementation for Dirac fermions if the model contains no Majorana
fermions. *)
module type Fermions =
sig
open Coupling
val psi_type : string
val psibar_type : string
val chi_type : string
val grav_type : string
val psi_incoming : string
val brs_psi_incoming : string
val psibar_incoming : string
val brs_psibar_incoming : string
val chi_incoming : string
val brs_chi_incoming : string
val grav_incoming : string
val psi_outgoing : string
val brs_psi_outgoing : string
val psibar_outgoing : string
val brs_psibar_outgoing : string
val chi_outgoing : string
val brs_chi_outgoing : string
val grav_outgoing : string
val psi_propagator : string
val psibar_propagator : string
val chi_propagator : string
val grav_propagator : string
val psi_projector : string
val psibar_projector : string
val chi_projector : string
val grav_projector : string
val psi_gauss : string
val psibar_gauss : string
val chi_gauss : string
val grav_gauss : string
val print_current : int * fermionbar * boson * fermion ->
string -> string -> string -> fuse2 -> unit
val print_current_mom : int * fermionbar * boson * fermion ->
string -> string -> string -> string -> string -> string
-> fuse2 -> unit
val print_current_p : int * fermion * boson * fermion ->
string -> string -> string -> fuse2 -> unit
val print_current_b : int * fermionbar * boson * fermionbar ->
string -> string -> string -> fuse2 -> unit
val print_current_g : int * fermionbar * boson * fermion ->
string -> string -> string -> string -> string -> string
-> fuse2 -> unit
val print_current_g4 : int * fermionbar * boson2 * fermion ->
string -> string -> string -> string -> fuse3 -> unit
val reverse_braket : lorentz -> bool
val use_module : string
val require_library : string list
val rcs : RCS.t
end
module Fortran_Fermions : Fermions =
struct
let rcs = RCS.rename rcs_file "Targets.Fortran_Fermions()"
[ "generates Fortran95 code for Dirac fermions";
"using revision 2000_10_A of module omega95" ]
open Coupling
open Format
let psi_type = "spinor"
let psibar_type = "conjspinor"
let chi_type = "???"
let grav_type = "???"
let psi_incoming = "u"
let brs_psi_incoming = "brs_u"
let psibar_incoming = "vbar"
let brs_psibar_incoming = "brs_vbar"
let chi_incoming = "???"
let brs_chi_incoming = "???"
let grav_incoming = "???"
let psi_outgoing = "v"
let brs_psi_outgoing = "brs_v"
let psibar_outgoing = "ubar"
let brs_psibar_outgoing = "brs_ubar"
let chi_outgoing = "???"
let brs_chi_outgoing = "???"
let grav_outgoing = "???"
let psi_propagator = "pr_psi"
let psibar_propagator = "pr_psibar"
let chi_propagator = "???"
let grav_propagator = "???"
let psi_projector = "pj_psi"
let psibar_projector = "pj_psibar"
let chi_projector = "???"
let grav_projector = "???"
let psi_gauss = "pg_psi"
let psibar_gauss = "pg_psibar"
let chi_gauss = "???"
let grav_gauss = "???"
let format_coupling coeff c =
match coeff with
| 1 -> c
| -1 -> "(-" ^ c ^")"
| coeff -> string_of_int coeff ^ "*" ^ c
let format_coupling_2 coeff c =
match coeff with
| 1 -> c
| -1 -> "-" ^ c
| coeff -> string_of_int coeff ^ "*" ^ c
(* \begin{dubious}
JR's coupling constant HACK, necessitated by tho's bad design descition.
\end{dubious} *)
let fastener s i ?p () =
try
let offset = (String.index s '(') in
if ((String.get s (String.length s - 1)) != ')') then
failwith "fastener: wrong usage of parentheses"
else
let func_name = (String.sub s 0 offset) and
tail =
(String.sub s (succ offset) (String.length s - offset - 2)) in
if (String.contains func_name ')') or
(String.contains tail '(') or
(String.contains tail ')') then
failwith "fastener: wrong usage of parentheses"
else
func_name ^ "(" ^ string_of_int i ^ "," ^ tail ^ ")"
with
| Not_found ->
if (String.contains s ')') then
failwith "fastener: wrong usage of parentheses"
else
match p with
| None -> s ^ "(" ^ string_of_int i ^ ")"
| Some p -> s ^ "(" ^ p ^ "*" ^ p ^ "," ^ string_of_int i ^ ")"
let print_fermion_current coeff f c wf1 wf2 fusion =
let c = format_coupling coeff c in
match fusion with
| F13 -> printf "%s_ff(%s,%s,%s)" f c wf1 wf2
| F31 -> printf "%s_ff(%s,%s,%s)" f c wf2 wf1
| F23 -> printf "f_%sf(%s,%s,%s)" f c wf1 wf2
| F32 -> printf "f_%sf(%s,%s,%s)" f c wf2 wf1
| F12 -> printf "f_f%s(%s,%s,%s)" f c wf1 wf2
| F21 -> printf "f_f%s(%s,%s,%s)" f c wf2 wf1
(* \begin{dubious}
Using a two element array for the combined vector-axial and scalar-pseudo
couplings helps to support HELAS as well. Since we will probably never
support general boson couplings with HELAS, it might be retired in favor
of two separate variables. For this [Model.constant_symbol] has to be
generalized.
\end{dubious} *)
(* \begin{dubious}
NB: passing the array instead of two separate constants would be a
\emph{bad} idea, because the support for Majorana spinors below will
have to flip signs!
\end{dubious} *)
let print_fermion_current2 coeff f c wf1 wf2 fusion =
let c = format_coupling_2 coeff c in
let c1 = fastener c 1 ()
and c2 = fastener c 2 () in
match fusion with
| F13 -> printf "%s_ff(%s,%s,%s,%s)" f c1 c2 wf1 wf2
| F31 -> printf "%s_ff(%s,%s,%s,%s)" f c1 c2 wf2 wf1
| F23 -> printf "f_%sf(%s,%s,%s,%s)" f c1 c2 wf1 wf2
| F32 -> printf "f_%sf(%s,%s,%s,%s)" f c1 c2 wf2 wf1
| F12 -> printf "f_f%s(%s,%s,%s,%s)" f c1 c2 wf1 wf2
| F21 -> printf "f_f%s(%s,%s,%s,%s)" f c1 c2 wf2 wf1
let print_fermion_current_mom1 coeff f c wf1 wf2 p1 p2 p12 fusion =
let c = format_coupling coeff c in
let c1 = fastener c 1 and
c2 = fastener c 2 in
match fusion with
| F13 -> printf "%s_ff(%s,%s,%s,%s)" f (c1 ~p:p12 ()) (c2 ~p:p12 ()) wf1 wf2
| F31 -> printf "%s_ff(%s,%s,%s,%s)" f (c1 ~p:p12 ()) (c2 ~p:p12 ()) wf2 wf1
| F23 -> printf "f_%sf(%s,%s,%s,%s)" f (c1 ~p:p1 ()) (c2 ~p:p1 ()) wf1 wf2
| F32 -> printf "f_%sf(%s,%s,%s,%s)" f (c1 ~p:p2 ()) (c2 ~p:p2 ()) wf2 wf1
| F12 -> printf "f_f%s(%s,%s,%s,%s)" f (c1 ~p:p2 ()) (c2 ~p:p2 ()) wf1 wf2
| F21 -> printf "f_f%s(%s,%s,%s,%s)" f (c1 ~p:p1 ()) (c2 ~p:p1 ()) wf2 wf1
let print_fermion_current_mom2 coeff f c wf1 wf2 p1 p2 p12 fusion =
let c = format_coupling coeff c in
let c1 = fastener c 1 and
c2 = fastener c 2 in
match fusion with
| F13 -> printf "%s_ff(%s,%s,@,%s,%s,%s)" f (c1 ~p:p12 ()) (c2 ~p:p12 ()) wf1 wf2 p12
| F31 -> printf "%s_ff(%s,%s,@,%s,%s,%s)" f (c1 ~p:p12 ()) (c2 ~p:p12 ()) wf2 wf1 p12
| F23 -> printf "f_%sf(%s,%s,@,%s,%s,%s)" f (c1 ~p:p1 ()) (c2 ~p:p1 ()) wf1 wf2 p1
| F32 -> printf "f_%sf(%s,%s,@,%s,%s,%s)" f (c1 ~p:p2 ()) (c2 ~p:p2 ()) wf2 wf1 p2
| F12 -> printf "f_f%s(%s,%s,@,%s,%s,%s)" f (c1 ~p:p2 ()) (c2 ~p:p2 ()) wf1 wf2 p2
| F21 -> printf "f_f%s(%s,%s,@,%s,%s,%s)" f (c1 ~p:p1 ()) (c2 ~p:p1 ()) wf2 wf1 p1
let print_current = function
| coeff, Psibar, VA, Psi -> print_fermion_current2 coeff "va"
| coeff, Psibar, VA2, Psi -> print_fermion_current coeff "va2"
| coeff, Psibar, V, Psi -> print_fermion_current coeff "v"
| coeff, Psibar, A, Psi -> print_fermion_current coeff "a"
| coeff, Psibar, VL, Psi -> print_fermion_current coeff "vl"
| coeff, Psibar, VR, Psi -> print_fermion_current coeff "vr"
| coeff, Psibar, VLR, Psi -> print_fermion_current2 coeff "vlr"
| coeff, Psibar, SP, Psi -> print_fermion_current2 coeff "sp"
| coeff, Psibar, S, Psi -> print_fermion_current coeff "s"
| coeff, Psibar, P, Psi -> print_fermion_current coeff "p"
| coeff, Psibar, SL, Psi -> print_fermion_current coeff "sl"
| coeff, Psibar, SR, Psi -> print_fermion_current coeff "sr"
| coeff, Psibar, SLR, Psi -> print_fermion_current2 coeff "slr"
| coeff, Psibar, _, Psi -> invalid_arg
"Targets.Fortran_Fermions: no superpotential here"
| _, Chibar, _, _ | _, _, _, Chi -> invalid_arg
"Targets.Fortran_Fermions: Majorana spinors not handled"
| _, Gravbar, _, _ | _, _, _, Grav -> invalid_arg
"Targets.Fortran_Fermions: Gravitinos not handled"
let print_current_mom = function
| coeff, Psibar, VLRM, Psi -> print_fermion_current_mom1 coeff "vlr"
| coeff, Psibar, SPM, Psi -> print_fermion_current_mom1 coeff "sp"
| coeff, Psibar, TVA, Psi -> print_fermion_current_mom1 coeff "tva"
| coeff, Psibar, TVAM, Psi -> print_fermion_current_mom2 coeff "tvam"
| coeff, Psibar, TLR, Psi -> print_fermion_current_mom1 coeff "tlr"
| coeff, Psibar, TLRM, Psi -> print_fermion_current_mom2 coeff "tlrm"
| coeff, Psibar, TRL, Psi -> print_fermion_current_mom1 coeff "trl"
| coeff, Psibar, TRLM, Psi -> print_fermion_current_mom2 coeff "trlm"
| coeff, Psibar, _, Psi -> invalid_arg
"Targets.Fortran_Fermions: only sigma tensor coupling here"
| _, Chibar, _, _ | _, _, _, Chi -> invalid_arg
"Targets.Fortran_Fermions: Majorana spinors not handled"
| _, Gravbar, _, _ | _, _, _, Grav -> invalid_arg
"Targets.Fortran_Fermions: Gravitinos not handled"
let print_current_p = function
| _, _, _, _ -> invalid_arg
"Targets.Fortran_Fermions: No clashing arrows here"
let print_current_b = function
| _, _, _, _ -> invalid_arg
"Targets.Fortran_Fermions: No clashing arrows here"
let print_current_g = function
| _, _, _, _ -> invalid_arg
"Targets.Fortran_Fermions: No gravitinos here"
let print_current_g4 = function
| _, _, _, _ -> invalid_arg
"Targets.Fortran_Fermions: No gravitinos here"
let reverse_braket= function
| Spinor -> true
| _ -> false
let use_module = "omega95"
let require_library =
["omega_spinors_2010_01_A"; "omega_spinor_cpls_2010_01_A"]
end
(* \thocwmodulesubsection{Main Functor} *)
module Make_Fortran (Fermions : Fermions)
(Fusion_Maker : Fusion.Maker) (P : Momentum.T) (M : Model.T) =
struct
let rcs_list =
[ RCS.rename rcs_file "Targets.Make_Fortran()"
[ "Interface for Whizard 2.X";
"NB: non-gauge vector couplings are not available yet" ];
Fermions.rcs ]
let require_library =
Fermions.require_library @
[ "omega_vectors_2010_01_A"; "omega_polarizations_2010_01_A";
"omega_couplings_2010_01_A"; "omega_color_2010_01_A";
"omega_utils_2010_01_A" ]
module CM = Colorize.It(M)
module F = Fusion_Maker(P)(M)
type amplitude = F.amplitude
module CF = Fusion.Multi(Fusion_Maker)(P)(M)
type amplitudes = CF.amplitudes
open Coupling
open Format
type output_mode =
| Single_Function
| Single_Module of int
| Single_File of int
| Multi_File of int
let line_length = ref 80
let continuation_lines = ref (-1) (* 255 *)
let kind = ref "default"
let fortran95 = ref true
let module_name = ref "omega_amplitude"
let output_mode = ref (Single_Module 10)
let use_modules = ref []
let whizard = ref false
let parameter_module = ref ""
let md5sum = ref None
let no_write = ref false
let km_write = ref false
let km_pure = ref false
let openmp = ref false
let options = Options.create
[ "90", Arg.Clear fortran95,
"don't use Fortran95 features that are not in Fortran90";
"kind", Arg.String (fun s -> kind := s),
"real and complex kind (default: " ^ !kind ^ ")";
"width", Arg.Int (fun w -> line_length := w), "maximum line length";
"continuation", Arg.Int (fun l -> continuation_lines := l),
"maximum # of continuation lines";
"module", Arg.String (fun s -> module_name := s), "module name";
"single_function", Arg.Unit (fun () -> output_mode := Single_Function),
"compute the matrix element(s) in a monolithis function";
"split_function", Arg.Int (fun n -> output_mode := Single_Module n),
"split the matrix element(s) into small functions [default, size = 10]";
"split_module", Arg.Int (fun n -> output_mode := Single_File n),
"split the matrix element(s) into small modules";
"split_file", Arg.Int (fun n -> output_mode := Multi_File n),
"split the matrix element(s) into small files";
"use", Arg.String (fun s -> use_modules := s :: !use_modules),
"use module";
"parameter_module", Arg.String (fun s -> parameter_module := s),
"parameter_module";
"md5sum", Arg.String (fun s -> md5sum := Some s),
"transfer MD5 checksum";
"whizard", Arg.Set whizard, "include WHIZARD interface";
"no_write", Arg.Set no_write, "no 'write' statements";
"kmatrix_write", Arg.Set km_write, "write K matrix functions";
"kmatrix_write_pure", Arg.Set km_pure, "write K matrix pure functions";
"openmp", Arg.Set openmp, "activate OpenMP support in generated code"]
(* Fortran style line continuation: *)
(* Default function to output spaces (copied from \texttt{format.ml}). *)
let blank_line = String.make 80 ' '
let rec display_blanks oc n =
if n > 0 then
if n <= 80 then
output oc blank_line 0 n
else begin
output oc blank_line 0 80;
display_blanks oc (n - 80)
end
(* Default function to output new lines (copied from \texttt{format.ml}). *)
let display_newline oc () =
output oc "\n" 0 1
(* [current_continuation_line]
\begin{itemize}
\item $\le0$: not continuing: print a straight newline,
\item $>0$: continuing: append [" &"] until we run up to [!continuation_lines].
NB: [!continuation_lines < 0] means \emph{unlimited} continuation lines.
\end{itemize} *)
let current_continuation_line = ref 1
exception Continuation_Lines of int
let fortran_newline oc () =
if !current_continuation_line > 0 then begin
if !continuation_lines >= 0 && !current_continuation_line > !continuation_lines then
raise (Continuation_Lines !current_continuation_line)
else begin
output oc " &" 0 2;
incr current_continuation_line
end
end;
display_newline oc ()
let nl () =
current_continuation_line := 0;
print_newline ();
current_continuation_line := 1
(* Make a formatter with default functions to output spaces and new lines. *)
let setup_fortran_formatter width oc =
set_all_formatter_output_functions
~out:(output oc)
~flush:(fun () -> flush oc)
~newline:(fortran_newline oc)
~spaces:(display_blanks oc);
set_margin (width - 2)
let print_list = function
| [] -> ()
| a :: rest ->
print_string a;
List.iter (fun s -> printf ",@ %s" s) rest
(* \thocwmodulesubsection{Variables and Declarations} *)
(* ["NC"] is already used up in the module ["constants"]: *)
let nc_parameter = "N_"
let omega_color_factor_abbrev = "OCF"
let openmp_tld_type = "thread_local_data"
let openmp_tld = "tld"
let flavors_symbol ?(decl = false) flavors =
(if !openmp & not decl then openmp_tld ^ "%" else "" ) ^
"oks_" ^ String.concat "" (List.map CM.flavor_symbol flavors)
let p2s p =
if p >= 0 && p <= 9 then
string_of_int p
else if p <= 36 then
String.make 1 (Char.chr (Char.code 'A' + p - 10))
else
"_"
let format_momentum p =
"p" ^ String.concat "" (List.map p2s p)
let format_p wf =
String.concat "" (List.map p2s (F.momentum_list wf))
let ext_momentum wf =
match F.momentum_list wf with
| [n] -> n
| _ -> invalid_arg "Targets.Fortran.ext_momentum"
module PSet = Set.Make (struct type t = int list let compare = compare end)
module WFSet = Set.Make (struct type t = F.wf let compare = compare end)
let add_tag wf name =
match F.wf_tag wf with
| None -> name
| Some tag -> name ^ "_" ^ tag
let variable ?(decl = false) wf =
(if !openmp & not decl then openmp_tld ^ "%" else "")
^ add_tag wf ("owf_" ^ CM.flavor_symbol (F.flavor wf) ^ "_" ^ format_p wf)
let momentum wf = "p" ^ format_p wf
let spin wf = "s(" ^ string_of_int (ext_momentum wf) ^ ")"
let format_multiple_variable ?(decl = false) wf i =
variable ~decl:decl wf ^ "_X" ^ string_of_int i
let multiple_variable ?(decl = false) amplitude dictionary wf =
try
format_multiple_variable ~decl:decl wf (dictionary amplitude wf)
with
| Not_found -> variable wf
let multiple_variables ?(decl = false) multiplicity wf =
try
List.map
(format_multiple_variable ~decl:decl wf)
(ThoList.range 1 (multiplicity wf))
with
| Not_found -> [variable ~decl:decl wf]
let declaration_chunk_size = 64
let declare_list_chunk multiplicity t = function
| [] -> ()
| wfs ->
printf " @[<2>%s :: " t;
print_list (ThoList.flatmap (multiple_variables ~decl:true multiplicity) wfs); nl ()
let declare_list multiplicity t = function
| [] -> ()
| wfs ->
List.iter
(declare_list_chunk multiplicity t)
(ThoList.chopn declaration_chunk_size wfs)
type declarations =
{ scalars : F.wf list;
spinors : F.wf list;
conjspinors : F.wf list;
realspinors : F.wf list;
ghostspinors : F.wf list;
vectorspinors : F.wf list;
vectors : F.wf list;
ward_vectors : F.wf list;
massive_vectors : F.wf list;
tensors_1 : F.wf list;
tensors_2 : F.wf list;
brs_scalars : F.wf list;
brs_spinors : F.wf list;
brs_conjspinors : F.wf list;
brs_realspinors : F.wf list;
brs_vectorspinors : F.wf list;
brs_vectors : F.wf list;
brs_massive_vectors : F.wf list }
let rec classify_wfs' acc = function
| [] -> acc
| wf :: rest ->
classify_wfs'
(match CM.lorentz (F.flavor wf) with
| Scalar -> {acc with scalars = wf :: acc.scalars}
| Spinor -> {acc with spinors = wf :: acc.spinors}
| ConjSpinor -> {acc with conjspinors = wf :: acc.conjspinors}
| Majorana -> {acc with realspinors = wf :: acc.realspinors}
| Maj_Ghost -> {acc with ghostspinors = wf :: acc.ghostspinors}
| Vectorspinor ->
{acc with vectorspinors = wf :: acc.vectorspinors}
| Vector -> {acc with vectors = wf :: acc.vectors}
(*i | Ward_Vector -> {acc with ward_vectors = wf :: acc.ward_vectors}
i*)
| Massive_Vector ->
{acc with massive_vectors = wf :: acc.massive_vectors}
| Tensor_1 -> {acc with tensors_1 = wf :: acc.tensors_1}
| Tensor_2 -> {acc with tensors_2 = wf :: acc.tensors_2}
| BRS Scalar -> {acc with brs_scalars = wf :: acc.brs_scalars}
| BRS Spinor -> {acc with brs_spinors = wf :: acc.brs_spinors}
| BRS ConjSpinor -> {acc with brs_conjspinors =
wf :: acc.brs_conjspinors}
| BRS Majorana -> {acc with brs_realspinors =
wf :: acc.brs_realspinors}
| BRS Vectorspinor -> {acc with brs_vectorspinors =
wf :: acc.brs_vectorspinors}
| BRS Vector -> {acc with brs_vectors = wf :: acc.brs_vectors}
| BRS Massive_Vector -> {acc with brs_massive_vectors =
wf :: acc.brs_massive_vectors}
| BRS _ -> invalid_arg "Targets.wfs_classify': not needed here")
rest
let classify_wfs wfs = classify_wfs'
{ scalars = []; spinors = []; conjspinors = []; realspinors = [];
ghostspinors = []; vectorspinors = []; vectors = [];
ward_vectors = [];
massive_vectors = []; tensors_1 = []; tensors_2 = [];
brs_scalars = [] ; brs_spinors = []; brs_conjspinors = [];
brs_realspinors = []; brs_vectorspinors = [];
brs_vectors = []; brs_massive_vectors = []}
wfs
(* \thocwmodulesubsection{Parameters} *)
type 'a parameters =
{ real_singles : 'a list;
real_arrays : ('a * int) list;
complex_singles : 'a list;
complex_arrays : ('a * int) list }
let rec classify_singles acc = function
| [] -> acc
| Real p :: rest -> classify_singles
{ acc with real_singles = p :: acc.real_singles } rest
| Complex p :: rest -> classify_singles
{ acc with complex_singles = p :: acc.complex_singles } rest
let rec classify_arrays acc = function
| [] -> acc
| (Real_Array p, rhs) :: rest -> classify_arrays
{ acc with real_arrays =
(p, List.length rhs) :: acc.real_arrays } rest
| (Complex_Array p, rhs) :: rest -> classify_arrays
{ acc with complex_arrays =
(p, List.length rhs) :: acc.complex_arrays } rest
let classify_parameters params =
classify_arrays
(classify_singles
{ real_singles = [];
real_arrays = [];
complex_singles = [];
complex_arrays = [] }
(List.map fst params.derived)) params.derived_arrays
(* \begin{dubious}
Unify this with the other code using [ThoList.chopn].
\end{dubious} *)
let rec schisma n l =
if List.length l <= n then
[l]
else
let a, b = ThoList.splitn n l in
[a] @ (schisma n b)
let rec schisma_num i n l =
if List.length l <= n then
[(i,l)]
else
let a, b = ThoList.splitn n l in
[(i,a)] @ (schisma_num (i+1) n b)
let declare_parameters' t = function
| [] -> ()
| plist ->
printf " @[<2>%s(kind=%s), public, save :: " t !kind;
print_list (List.map CM.constant_symbol plist); nl ()
let declare_parameters t plist =
List.iter (declare_parameters' t) plist
let declare_parameter_array t (p, n) =
printf " @[<2>%s(kind=%s), dimension(%d), public, save :: %s"
t !kind n (CM.constant_symbol p); nl ()
let default_parameter (x, v) =
printf "@ %s = %g_%s" (CM.constant_symbol x) v !kind
let declare_default_parameters t = function
| [] -> ()
| p :: plist ->
printf " @[<2>%s(kind=%s), public, save ::" t !kind;
default_parameter p;
List.iter (fun p' -> printf ","; default_parameter p') plist;
nl ()
let rec format_constant = function
| I -> sprintf "cmplx (0.0_%s, 1.0_%s)" !kind !kind
| Const c when c < 0 -> sprintf "(%d.0_%s)" c !kind
| Const c -> sprintf "%d.0_%s" c !kind
| _ -> invalid_arg "format_constant"
let rec eval_parameter' = function
| I -> printf "cmplx (0.0_%s, 1.0_%s)" !kind !kind
| Const c when c < 0 -> printf "(%d.0_%s)" c !kind
| Const c -> printf "%d.0_%s" c !kind
| Atom x -> printf "%s" (CM.constant_symbol x)
| Sum [] -> printf "0.0_%s" !kind
| Sum [x] -> eval_parameter' x
| Sum (x :: xs) ->
printf "@,("; eval_parameter' x;
List.iter (fun x -> printf "@, + "; eval_parameter' x) xs;
printf ")"
| Diff (x, y) ->
printf "@,("; eval_parameter' x;
printf " - "; eval_parameter' y; printf ")"
| Neg x -> printf "@,( - "; eval_parameter' x; printf ")"
| Prod [] -> printf "1.0_%s" !kind
| Prod [x] -> eval_parameter' x
| Prod (x :: xs) ->
printf "@,("; eval_parameter' x;
List.iter (fun x -> printf " * "; eval_parameter' x) xs;
printf ")"
| Quot (x, y) ->
printf "@,("; eval_parameter' x;
printf " / "; eval_parameter' y; printf ")"
| Rec x ->
printf "@, (1.0_%s / " !kind; eval_parameter' x; printf ")"
| Pow (x, n) ->
printf "@,("; eval_parameter' x; printf "**%d" n; printf ")"
| Sqrt x -> printf "@,sqrt ("; eval_parameter' x; printf ")"
| Sin x -> printf "@,sin ("; eval_parameter' x; printf ")"
| Cos x -> printf "@,cos ("; eval_parameter' x; printf ")"
| Tan x -> printf "@,tan ("; eval_parameter' x; printf ")"
| Cot x -> printf "@,cot ("; eval_parameter' x; printf ")"
| Atan2 (y, x) -> printf "@,atan2 ("; eval_parameter' y;
printf ",@ "; eval_parameter' x; printf ")"
| Conj x -> printf "@,conjg ("; eval_parameter' x; printf ")"
let strip_single_tag = function
| Real x -> x
| Complex x -> x
let strip_array_tag = function
| Real_Array x -> x
| Complex_Array x -> x
let eval_parameter (lhs, rhs) =
let x = CM.constant_symbol (strip_single_tag lhs) in
printf " @[<2>%s = " x; eval_parameter' rhs; nl ()
let eval_para_list n l =
printf " subroutine setup_parameters%s ()" (string_of_int n); nl();
List.iter eval_parameter l;
printf " end subroutine setup_parameters%s" (string_of_int n); nl()
let eval_parameter_pair (lhs, rhs) =
let x = CM.constant_symbol (strip_array_tag lhs) in
let _ = List.fold_left (fun i rhs' ->
printf " @[<2>%s(%d) = " x i; eval_parameter' rhs'; nl ();
succ i) 1 rhs in
()
let eval_para_pair_list n l =
printf " subroutine setup_parameters%s ()" (string_of_int n); nl();
List.iter eval_parameter_pair l;
printf " end subroutine setup_parameters%s" (string_of_int n); nl()
let print_echo fmt p =
let s = CM.constant_symbol p in
printf " write (unit = *, fmt = fmt_%s) \"%s\", %s"
fmt s s; nl ()
let print_echo_array fmt (p, n) =
let s = CM.constant_symbol p in
for i = 1 to n do
printf " write (unit = *, fmt = fmt_%s_array) " fmt ;
printf "\"%s\", %d, %s(%d)" s i s i; nl ()
done
let parameters_to_fortran oc params =
setup_fortran_formatter !line_length oc;
let declarations = classify_parameters params in
printf "module %s" !parameter_module; nl ();
printf " use kinds"; nl ();
printf " use constants"; nl ();
printf " implicit none"; nl ();
printf " private"; nl ();
printf " @[<2>public :: setup_parameters";
if !no_write then begin
printf "! No print_parameters"; nl();
end else begin
printf "@,, print_parameters"; nl ();
end;
declare_default_parameters "real" params.input;
declare_parameters "real" (schisma 69 declarations.real_singles);
List.iter (declare_parameter_array "real") declarations.real_arrays;
declare_parameters "complex" (schisma 69 declarations.complex_singles);
List.iter (declare_parameter_array "complex") declarations.complex_arrays;
printf "contains"; nl ();
printf " ! derived parameters:"; nl ();
let shredded = schisma_num 1 120 params.derived in
let shredded_arrays = schisma_num 1 120 params.derived_arrays in
let num_sub = List.length shredded in
let num_sub_arrays = List.length shredded_arrays in
printf " !length: %s" (string_of_int (List.length params.derived));
nl();
printf " !Num_Sub: %s" (string_of_int num_sub); nl();
List.iter (fun (i,l) -> eval_para_list i l) shredded;
List.iter (fun (i,l) -> eval_para_pair_list (num_sub + i) l)
shredded_arrays;
printf " subroutine setup_parameters ()"; nl();
let sum_sub = num_sub + num_sub_arrays in
for i = 1 to sum_sub do
printf " call setup_parameters%s" (string_of_int i); nl();
done;
printf " end subroutine setup_parameters"; nl();
if !no_write then begin
printf "! No print_parameters"; nl();
end else begin
printf " subroutine print_parameters ()"; nl();
printf " @[<2>character(len=*), parameter ::";
printf "@ fmt_real = \"(A12,4X,' = ',E25.18)\",";
printf "@ fmt_complex = \"(A12,4X,' = ',E25.18,' + i*',E25.18)\",";
printf "@ fmt_real_array = \"(A12,'(',I2.2,')',' = ',E25.18)\",";
printf "@ fmt_complex_array = ";
printf "\"(A12,'(',I2.2,')',' = ',E25.18,' + i*',E25.18)\""; nl ();
printf " @[<2>write (unit = *, fmt = \"(A)\") @,";
printf "\"default values for the input parameters:\""; nl ();
List.iter (fun (p, _) -> print_echo "real" p) params.input;
printf " @[<2>write (unit = *, fmt = \"(A)\") @,";
printf "\"derived parameters:\""; nl ();
List.iter (print_echo "real") declarations.real_singles;
List.iter (print_echo "complex") declarations.complex_singles;
List.iter (print_echo_array "real") declarations.real_arrays;
List.iter (print_echo_array "complex") declarations.complex_arrays;
printf " end subroutine print_parameters"; nl();
end;
printf "end module %s" !parameter_module; nl ();
printf "! O'Mega revision control information:"; nl ();
List.iter (fun s -> printf "! %s" s; nl ())
(ThoList.flatmap RCS.summary (M.rcs :: rcs_list));
printf "!!! program test_parameters"; nl();
printf "!!! use %s" !parameter_module; nl();
printf "!!! call setup_parameters ()"; nl();
printf "!!! call print_parameters ()"; nl();
printf "!!! end program test_parameters"; nl()
(* \thocwmodulesubsection{Run-Time Diagnostics} *)
type diagnostic = All | Arguments | Momenta | Gauge
type diagnostic_mode = Off | Warn | Panic
let warn mode =
match !mode with
| Off -> false
| Warn -> true
| Panic -> true
let panic mode =
match !mode with
| Off -> false
| Warn -> false
| Panic -> true
let suffix mode =
if panic mode then
"panic"
else
"warn"
let diagnose_arguments = ref Off
let diagnose_momenta = ref Off
let diagnose_gauge = ref Off
let rec parse_diagnostic = function
| All, panic ->
parse_diagnostic (Arguments, panic);
parse_diagnostic (Momenta, panic);
parse_diagnostic (Gauge, panic)
| Arguments, panic ->
diagnose_arguments := if panic then Panic else Warn
| Momenta, panic ->
diagnose_momenta := if panic then Panic else Warn
| Gauge, panic ->
diagnose_gauge := if panic then Panic else Warn
(* If diagnostics are required, we have to switch off
Fortran95 features like pure functions. *)
let parse_diagnostics = function
| [] -> ()
| diagnostics ->
fortran95 := false;
List.iter parse_diagnostic diagnostics
(* \thocwmodulesubsection{Amplitude} *)
let declare_momenta_chunk = function
| [] -> ()
| momenta ->
printf " @[<2>type(momentum) :: ";
print_list (List.map format_momentum momenta); nl ()
let declare_momenta = function
| [] -> ()
| momenta ->
List.iter
declare_momenta_chunk
(ThoList.chopn declaration_chunk_size momenta)
let declare_wavefunctions multiplicity wfs =
let wfs' = classify_wfs wfs in
declare_list multiplicity ("complex(kind=" ^ !kind ^ ")")
(wfs'.scalars @ wfs'.brs_scalars);
declare_list multiplicity ("type(" ^ Fermions.psi_type ^ ")")
(wfs'.spinors @ wfs'.brs_spinors);
declare_list multiplicity ("type(" ^ Fermions.psibar_type ^ ")")
(wfs'.conjspinors @ wfs'.brs_conjspinors);
declare_list multiplicity ("type(" ^ Fermions.chi_type ^ ")")
(wfs'.realspinors @ wfs'.brs_realspinors @ wfs'.ghostspinors);
declare_list multiplicity ("type(" ^ Fermions.grav_type ^ ")") wfs'.vectorspinors;
declare_list multiplicity "type(vector)" (wfs'.vectors @ wfs'.massive_vectors @
wfs'.brs_vectors @ wfs'.brs_massive_vectors @ wfs'.ward_vectors);
declare_list multiplicity "type(tensor2odd)" wfs'.tensors_1;
declare_list multiplicity "type(tensor)" wfs'.tensors_2
let flavors a = F.incoming a @ F.outgoing a
let declare_brakets_chunk = function
| [] -> ()
| amplitudes ->
printf " @[<2>complex(kind=%s) :: " !kind;
print_list (List.map (fun a -> flavors_symbol ~decl:true (flavors a)) amplitudes); nl ()
let declare_brakets = function
| [] -> ()
| amplitudes ->
List.iter
declare_brakets_chunk
(ThoList.chopn declaration_chunk_size amplitudes)
let print_variable_declarations amplitudes =
let multiplicity = CF.multiplicity amplitudes
and processes = CF.processes amplitudes in
declare_momenta
(PSet.elements
(List.fold_left
(fun set a ->
PSet.union set (List.fold_right
(fun wf -> PSet.add (F.momentum_list wf))
(F.externals a) PSet.empty))
PSet.empty processes));
declare_momenta
(PSet.elements
(List.fold_left
(fun set a ->
PSet.union set (List.fold_right
(fun wf -> PSet.add (F.momentum_list wf))
(F.variables a) PSet.empty))
PSet.empty processes));
if !openmp then begin
printf " type %s@[<2>" openmp_tld_type;
nl ();
end ;
declare_wavefunctions multiplicity
(WFSet.elements
(List.fold_left
(fun set a ->
WFSet.union set (List.fold_right WFSet.add (F.externals a) WFSet.empty))
WFSet.empty processes));
declare_wavefunctions multiplicity
(WFSet.elements
(List.fold_left
(fun set a ->
WFSet.union set (List.fold_right WFSet.add (F.variables a) WFSet.empty))
WFSet.empty processes));
declare_brakets processes;
if !openmp then begin
printf "@] end type %s\n" openmp_tld_type;
printf " type(%s) :: %s" openmp_tld_type openmp_tld;
nl ();
end
(* [print_current] is the most important function that has to match the functions
in \verb+omega95+ (see appendix~\ref{sec:fortran}). It offers plentiful
opportunities for making mistakes, in particular those related to signs.
We start with a few auxiliary functions: *)
let children2 rhs =
match F.children rhs with
| [wf1; wf2] -> (wf1, wf2)
| _ -> failwith "Targets.children2: can't happen"
let children3 rhs =
match F.children rhs with
| [wf1; wf2; wf3] -> (wf1, wf2, wf3)
| _ -> invalid_arg "Targets.children3: can't happen"
(* Note that it is (marginally) faster to multiply the two scalar products
with the coupling constant than the four vector components.
\begin{dubious}
This could be part of \verb+omegalib+ as well \ldots
\end{dubious} *)
let format_coeff = function
| 1 -> ""
| -1 -> "-"
| coeff -> "(" ^ string_of_int coeff ^ ")*"
let format_coupling coeff c =
match coeff with
| 1 -> c
| -1 -> "(-" ^ c ^")"
| coeff -> string_of_int coeff ^ "*" ^ c
(* \begin{dubious}
The following is error prone and should be generated automagically.
\end{dubious} *)
let print_vector4 c wf1 wf2 wf3 fusion (coeff, contraction) =
match contraction, fusion with
| C_12_34, (F341|F431|F342|F432|F123|F213|F124|F214)
| C_13_42, (F241|F421|F243|F423|F132|F312|F134|F314)
| C_14_23, (F231|F321|F234|F324|F142|F412|F143|F413) ->
printf "((%s%s)*(%s*%s))*%s" (format_coeff coeff) c wf1 wf2 wf3
| C_12_34, (F134|F143|F234|F243|F312|F321|F412|F421)
| C_13_42, (F124|F142|F324|F342|F213|F231|F413|F431)
| C_14_23, (F123|F132|F423|F432|F214|F241|F314|F341) ->
printf "((%s%s)*(%s*%s))*%s" (format_coeff coeff) c wf2 wf3 wf1
| C_12_34, (F314|F413|F324|F423|F132|F231|F142|F241)
| C_13_42, (F214|F412|F234|F432|F123|F321|F143|F341)
| C_14_23, (F213|F312|F243|F342|F124|F421|F134|F431) ->
printf "((%s%s)*(%s*%s))*%s" (format_coeff coeff) c wf1 wf3 wf2
let print_add_vector4 c wf1 wf2 wf3 fusion (coeff, contraction) =
printf "@ + ";
print_vector4 c wf1 wf2 wf3 fusion (coeff, contraction)
let print_vector4_km c pa pb wf1 wf2 wf3 fusion (coeff, contraction) =
match contraction, fusion with
| C_12_34, (F341|F431|F342|F432|F123|F213|F124|F214)
| C_13_42, (F241|F421|F243|F423|F132|F312|F134|F314)
| C_14_23, (F231|F321|F234|F324|F142|F412|F143|F413) ->
printf "((%s%s%s+%s))*(%s*%s))*%s"
(format_coeff coeff) c pa pb wf1 wf2 wf3
| C_12_34, (F134|F143|F234|F243|F312|F321|F412|F421)
| C_13_42, (F124|F142|F324|F342|F213|F231|F413|F431)
| C_14_23, (F123|F132|F423|F432|F214|F241|F314|F341) ->
printf "((%s%s%s+%s))*(%s*%s))*%s"
(format_coeff coeff) c pa pb wf2 wf3 wf1
| C_12_34, (F314|F413|F324|F423|F132|F231|F142|F241)
| C_13_42, (F214|F412|F234|F432|F123|F321|F143|F341)
| C_14_23, (F213|F312|F243|F342|F124|F421|F134|F431) ->
printf "((%s%s%s+%s))*(%s*%s))*%s"
(format_coeff coeff) c pa pb wf1 wf3 wf2
let print_add_vector4_km c pa pb wf1 wf2 wf3 fusion (coeff, contraction) =
printf "@ + ";
print_vector4_km c pa pb wf1 wf2 wf3 fusion (coeff, contraction)
let print_dscalar4 c wf1 wf2 wf3 p1 p2 p3 p123
fusion (coeff, contraction) =
match contraction, fusion with
| C_12_34, (F341|F431|F342|F432|F123|F213|F124|F214)
| C_13_42, (F241|F421|F243|F423|F132|F312|F134|F314)
| C_14_23, (F231|F321|F234|F324|F142|F412|F143|F413) ->
printf "((%s%s)*(%s*%s)*(%s*%s)*%s*%s*%s)"
(format_coeff coeff) c p1 p2 p3 p123 wf1 wf2 wf3
| C_12_34, (F134|F143|F234|F243|F312|F321|F412|F421)
| C_13_42, (F124|F142|F324|F342|F213|F231|F413|F431)
| C_14_23, (F123|F132|F423|F432|F214|F241|F314|F341) ->
printf "((%s%s)*(%s*%s)*(%s*%s)*%s*%s*%s)"
(format_coeff coeff) c p2 p3 p1 p123 wf1 wf2 wf3
| C_12_34, (F314|F413|F324|F423|F132|F231|F142|F241)
| C_13_42, (F214|F412|F234|F432|F123|F321|F143|F341)
| C_14_23, (F213|F312|F243|F342|F124|F421|F134|F431) ->
printf "((%s%s)*(%s*%s)*(%s*%s)*%s*%s*%s)"
(format_coeff coeff) c p1 p3 p2 p123 wf1 wf2 wf3
let print_add_dscalar4 c wf1 wf2 wf3 p1 p2 p3 p123
fusion (coeff, contraction) =
printf "@ + ";
print_dscalar4 c wf1 wf2 wf3 p1 p2 p3 p123 fusion (coeff, contraction)
let print_dscalar2_vector2 c wf1 wf2 wf3 p1 p2 p3 p123
fusion (coeff, contraction) =
failwith "Targets.Fortran.print_dscalar2_vector2: incomplete!";
match contraction, fusion with
| C_12_34, (F134|F143|F234|F243) ->
printf "((%s%s)*(%s*%s)*(%s*%s)*%s)"
(format_coeff coeff) c p123 p1 wf2 wf3 wf1
| C_12_34, (F312|F321|F412|F421) ->
printf "((%s%s)*((%s*%s)*%s*%s)*%s)"
(format_coeff coeff) c p2 p3 wf2 wf3 wf1
| C_12_34, (F341|F431|F342|F432|F123|F213|F124|F214)
| C_13_42, (F241|F421|F243|F423|F132|F312|F134|F314)
| C_14_23, (F231|F321|F234|F324|F142|F412|F143|F413) ->
printf "((%s%s)*(%s*%s)*(%s*%s)*%s*%s*%s)"
(format_coeff coeff) c p1 p2 p3 p123 wf1 wf2 wf3
| C_13_42, (F124|F142|F324|F342|F213|F231|F413|F431)
| C_14_23, (F123|F132|F423|F432|F214|F241|F314|F341) ->
printf "((%s%s)*(%s*%s)*(%s*%s)*%s*%s*%s)"
(format_coeff coeff) c p2 p3 p1 p123 wf1 wf2 wf3
| C_12_34, (F314|F413|F324|F423|F132|F231|F142|F241)
| C_13_42, (F214|F412|F234|F432|F123|F321|F143|F341)
| C_14_23, (F213|F312|F243|F342|F124|F421|F134|F431) ->
printf "((%s%s)*(%s*%s)*(%s*%s)*%s*%s*%s)"
(format_coeff coeff) c p1 p3 p2 p123 wf1 wf2 wf3
let print_add_dscalar2_vector2 c wf1 wf2 wf3 p1 p2 p3 p123
fusion (coeff, contraction) =
printf "@ + ";
print_dscalar2_vector2 c wf1 wf2 wf3 p1 p2 p3 p123
fusion (coeff, contraction)
let print_current amplitude dictionary rhs =
match F.coupling rhs with
| V3 (vertex, fusion, constant) ->
let ch1, ch2 = children2 rhs in
let wf1 = multiple_variable amplitude dictionary ch1
and wf2 = multiple_variable amplitude dictionary ch2
and p1 = momentum ch1
and p2 = momentum ch2
and m1 = CM.mass_symbol (F.flavor ch1)
and m2 = CM.mass_symbol (F.flavor ch2) in
let c = CM.constant_symbol constant in
printf "@, %s " (if (F.sign rhs) < 0 then "-" else "+");
begin match vertex with
(* Fermionic currents $\bar\psi\fmslash{A}\psi$ and $\bar\psi\phi\psi$
are handled by the [Fermions] module, since they depend on the
choice of Feynman rules: Dirac or Majorana. *)
| FBF (coeff, fb, b, f) ->
begin match coeff, fb, b, f with
| _, Psibar, VLRM, Psi | _, Psibar, SPM, Psi
| _, Psibar, TVA, Psi | _, Psibar, TVAM, Psi
| _, Psibar, TLR, Psi | _, Psibar, TLRM, Psi
| _, Psibar, TRL, Psi | _, Psibar, TRLM, Psi ->
let p12 = Printf.sprintf "(-%s-%s)" p1 p2 in
Fermions.print_current_mom (coeff, fb, b, f) c wf1 wf2 p1 p2
p12 fusion
| _, _, _, _ ->
Fermions.print_current (coeff, fb, b, f) c wf1 wf2 fusion
end
| PBP (coeff, f1, b, f2) ->
Fermions.print_current_p (coeff, f1, b, f2) c wf1 wf2 fusion
| BBB (coeff, fb1, b, fb2) ->
Fermions.print_current_b (coeff, fb1, b, fb2) c wf1 wf2 fusion
| GBG (coeff, fb, b, f) -> let p12 =
Printf.sprintf "(-%s-%s)" p1 p2 in
Fermions.print_current_g (coeff, fb, b, f) c wf1 wf2 p1 p2
p12 fusion
(* Table~\ref{tab:dim4-bosons} is a bit misleading, since if includes
totally antisymmetric structure constants. The space-time part alone
is also totally antisymmetric: *)
| Gauge_Gauge_Gauge coeff ->
let c = format_coupling coeff c in
begin match fusion with
| (F23|F31|F12) ->
printf "g_gg(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2
| (F32|F13|F21) ->
printf "g_gg(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1
end
(* In [Aux_Gauge_Gauge], we can not rely on antisymmetry alone, because of the
different Lorentz representations of the auxialiary and the gauge field.
Instead we have to provide the sign in
\begin{equation}
(V_2 \wedge V_3) \cdot T_1 =
\begin{cases}
V_2 \cdot (T_1 \cdot V_3) = - V_2 \cdot (V_3 \cdot T_1) & \\
V_3 \cdot (V_2 \cdot T_1) = - V_3 \cdot (T_1 \cdot V_2) &
\end{cases}
\end{equation}
ourselves. Alternatively, one could provide \verb+g_xg+ mirroring
\verb+g_gx+. *)
| Aux_Gauge_Gauge coeff ->
let c = format_coupling coeff c in
begin match fusion with
| F23 -> printf "x_gg(%s,%s,%s)" c wf1 wf2
| F32 -> printf "x_gg(%s,%s,%s)" c wf2 wf1
| F12 -> printf "g_gx(%s,%s,%s)" c wf2 wf1
| F21 -> printf "g_gx(%s,%s,%s)" c wf1 wf2
| F13 -> printf "(-1)*g_gx(%s,%s,%s)" c wf2 wf1
| F31 -> printf "(-1)*g_gx(%s,%s,%s)" c wf1 wf2
end
(* These cases are symmetric and we just have to juxtapose the correct fields
and provide parentheses to minimize the number of multiplications. *)
| Scalar_Vector_Vector coeff ->
let c = format_coupling coeff c in
begin match fusion with
| (F23|F32) -> printf "%s*(%s*%s)" c wf1 wf2
| (F12|F13) -> printf "(%s*%s)*%s" c wf1 wf2
| (F21|F31) -> printf "(%s*%s)*%s" c wf2 wf1
end
| Aux_Vector_Vector coeff ->
let c = format_coupling coeff c in
begin match fusion with
| (F23|F32) -> printf "%s*(%s*%s)" c wf1 wf2
| (F12|F13) -> printf "(%s*%s)*%s" c wf1 wf2
| (F21|F31) -> printf "(%s*%s)*%s" c wf2 wf1
end
(* Even simpler: *)
| Scalar_Scalar_Scalar coeff ->
printf "(%s*%s*%s)" (format_coupling coeff c) wf1 wf2
| Aux_Scalar_Scalar coeff ->
printf "(%s*%s*%s)" (format_coupling coeff c) wf1 wf2
| Aux_Scalar_Vector coeff ->
let c = format_coupling coeff c in
begin match fusion with
| (F13|F31) -> printf "%s*(%s*%s)" c wf1 wf2
| (F23|F21) -> printf "(%s*%s)*%s" c wf1 wf2
| (F32|F12) -> printf "(%s*%s)*%s" c wf2 wf1
end
| Vector_Scalar_Scalar coeff ->
let c = format_coupling coeff c in
begin match fusion with
| F23 -> printf "v_ss(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2
| F32 -> printf "v_ss(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1
| F12 -> printf "s_vs(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2
| F21 -> printf "s_vs(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1
| F13 -> printf "(-1)*s_vs(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2
| F31 -> printf "(-1)*s_vs(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1
end
| Graviton_Scalar_Scalar coeff ->
let c = format_coupling coeff c in
begin match fusion with
| F12 -> printf "s_gravs(%s,%s,-(%s+%s),%s,%s,%s)" c m2 p1 p2 p2 wf1 wf2
| F21 -> printf "s_gravs(%s,%s,-(%s+%s),%s,%s,%s)" c m1 p1 p2 p1 wf2 wf1
| F13 -> printf "s_gravs(%s,%s,%s,-(%s+%s),%s,%s)" c m2 p2 p1 p2 wf1 wf2
| F31 -> printf "s_gravs(%s,%s,%s,-(%s+%s),%s,%s)" c m1 p1 p1 p2 wf2 wf1
| F23 -> printf "grav_ss(%s,%s,%s,%s,%s,%s)" c m1 p1 p2 wf1 wf2
| F32 -> printf "grav_ss(%s,%s,%s,%s,%s,%s)" c m1 p2 p1 wf2 wf1
end
(* In producing a vector in the fusion we always contract the rightmost index with the
vector wavefunction from [rhs]. So the first momentum is always the one of the
vector boson produced in the fusion, while the second one is that from the [rhs].
This makes the cases [F12] and [F13] as well as [F21] and [F31] equal. In principle,
we could have already done this for the [Graviton_Scalar_Scalar] case. *)
| Graviton_Vector_Vector coeff ->
let c = format_coupling coeff c in
begin match fusion with
| (F12|F13) -> printf "v_gravv(%s,%s,-(%s+%s),%s,%s,%s)" c m2 p1 p2 p2 wf1 wf2
| (F21|F31) -> printf "v_gravv(%s,%s,-(%s+%s),%s,%s,%s)" c m1 p1 p2 p1 wf2 wf1
| F23 -> printf "grav_vv(%s,%s,%s,%s,%s,%s)" c m1 p1 p2 wf1 wf2
| F32 -> printf "grav_vv(%s,%s,%s,%s,%s,%s)" c m1 p2 p1 wf2 wf1
end
| Graviton_Spinor_Spinor coeff ->
let c = format_coupling coeff c in
begin match fusion with
| F23 -> printf "f_gravf(%s,%s,-(%s+%s),(-%s),%s,%s)" c m2 p1 p2 p2 wf1 wf2
| F32 -> printf "f_gravf(%s,%s,-(%s+%s),(-%s),%s,%s)" c m1 p1 p2 p1 wf2 wf1
| F12 -> printf "f_fgrav(%s,%s,%s,%s+%s,%s,%s)" c m1 p1 p1 p2 wf1 wf2
| F21 -> printf "f_fgrav(%s,%s,%s,%s+%s,%s,%s)" c m2 p2 p1 p2 wf2 wf1
| F13 -> printf "grav_ff(%s,%s,%s,(-%s),%s,%s)" c m1 p1 p2 wf1 wf2
| F31 -> printf "grav_ff(%s,%s,%s,(-%s),%s,%s)" c m1 p2 p1 wf2 wf1
end
| Dim4_Vector_Vector_Vector_T coeff ->
let c = format_coupling coeff c in
begin match fusion with
| F23 -> printf "tkv_vv(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2
| F32 -> printf "tkv_vv(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1
| F12 -> printf "tv_kvv(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2
| F21 -> printf "tv_kvv(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1
| F13 -> printf "(-1)*tv_kvv(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2
| F31 -> printf "(-1)*tv_kvv(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1
end
| Dim4_Vector_Vector_Vector_L coeff ->
let c = format_coupling coeff c in
begin match fusion with
| F23 -> printf "lkv_vv(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2
| F32 -> printf "lkv_vv(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1
| F12 | F13 -> printf "lv_kvv(%s,%s,%s,%s)" c wf1 p1 wf2
| F21 | F31 -> printf "lv_kvv(%s,%s,%s,%s)" c wf2 p2 wf1
end
| Dim6_Gauge_Gauge_Gauge coeff ->
let c = format_coupling coeff c in
begin match fusion with
| F23 | F31 | F12 ->
printf "kg_kgkg(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2
| F32 | F13 | F21 ->
printf "kg_kgkg(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1
end
| Dim4_Vector_Vector_Vector_T5 coeff ->
let c = format_coupling coeff c in
begin match fusion with
| F23 -> printf "t5kv_vv(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2
| F32 -> printf "t5kv_vv(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1
| F12 | F13 -> printf "t5v_kvv(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2
| F21 | F31 -> printf "t5v_kvv(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1
end
| Dim4_Vector_Vector_Vector_L5 coeff ->
let c = format_coupling coeff c in
begin match fusion with
| F23 -> printf "l5kv_vv(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2
| F32 -> printf "l5kv_vv(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1
| F12 -> printf "l5v_kvv(%s,%s,%s,%s)" c wf1 p1 wf2
| F21 -> printf "l5v_kvv(%s,%s,%s,%s)" c wf2 p2 wf1
| F13 -> printf "(-1)*l5v_kvv(%s,%s,%s,%s)" c wf1 p1 wf2
| F31 -> printf "(-1)*l5v_kvv(%s,%s,%s,%s)" c wf2 p2 wf1
end
| Dim6_Gauge_Gauge_Gauge_5 coeff ->
let c = format_coupling coeff c in
begin match fusion with
| F23 -> printf "kg5_kgkg(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2
| F32 -> printf "kg5_kgkg(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1
| F12 -> printf "kg_kg5kg(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2
| F21 -> printf "kg_kg5kg(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1
| F13 -> printf "(-1)*kg_kg5kg(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2
| F31 -> printf "(-1)*kg_kg5kg(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1
end
| Aux_DScalar_DScalar coeff ->
let c = format_coupling coeff c in
begin match fusion with
| (F23|F32) ->
printf "%s*(%s*%s)*(%s*%s)" c p1 p2 wf1 wf2
| (F12|F13) ->
printf "%s*(-((%s+%s)*%s))*(%s*%s)" c p1 p2 p2 wf1 wf2
| (F21|F31) ->
printf "%s*(-((%s+%s)*%s))*(%s*%s)" c p1 p2 p1 wf1 wf2
end
| Aux_Vector_DScalar coeff ->
let c = format_coupling coeff c in
begin match fusion with
| F23 -> printf "%s*(%s*%s)*%s" c wf1 p2 wf2
| F32 -> printf "%s*(%s*%s)*%s" c wf2 p1 wf1
| F12 -> printf "%s*(-((%s+%s)*%s))*%s" c p1 p2 wf2 wf1
| F21 -> printf "%s*(-((%s+%s)*%s))*%s" c p1 p2 wf1 wf2
| (F13|F31) -> printf "(-(%s+%s))*(%s*%s*%s)" p1 p2 c wf1 wf2
end
| Dim5_Scalar_Gauge2 coeff ->
let c = format_coupling coeff c in
begin match fusion with
| (F23|F32) -> printf "(%s)*((%s*%s)*(%s*%s) - (%s*%s)*(%s*%s))"
c p1 wf2 p2 wf1 p1 p2 wf2 wf1
| (F12|F13) -> printf "(%s)*%s*((-((%s+%s)*%s))*%s - ((-(%s+%s)*%s))*%s)"
c wf1 p1 p2 wf2 p2 p1 p2 p2 wf2
| (F21|F31) -> printf "(%s)*%s*((-((%s+%s)*%s))*%s - ((-(%s+%s)*%s))*%s)"
c wf2 p2 p1 wf1 p1 p1 p2 p1 wf1
end
| Dim5_Scalar_Gauge2_Skew coeff ->
let c = format_coupling coeff c in
begin match fusion with
| (F23|F32) -> printf "(- phi_vv (%s, %s, %s, %s, %s))" c p1 p2 wf1 wf2
| (F12|F13) -> printf "(- v_phiv (%s, %s, %s, %s, %s))" c wf1 p1 p2 wf2
| (F21|F31) -> printf "v_phiv (%s, %s, %s, %s, %s)" c wf2 p1 p2 wf1
end
| Dim5_Scalar_Vector_Vector_T coeff ->
let c = format_coupling coeff c in
begin match fusion with
| (F23|F32) -> printf "(%s)*(%s*%s)*(%s*%s)" c p1 wf2 p2 wf1
| (F12|F13) -> printf "(%s)*%s*(-((%s+%s)*%s))*%s" c wf1 p1 p2 wf2 p2
| (F21|F31) -> printf "(%s)*%s*(-((%s+%s)*%s))*%s" c wf2 p2 p1 wf1 p1
end
| Dim5_Scalar_Vector_Vector_U coeff ->
let c = format_coupling coeff c in
begin match fusion with
- | (F23|F32) -> printf
- "(%s)*((%s*%s)*(-(%s+%s)*%s) - (%s*%s)*((%s+%s)*%s) + ((%s+%s)*(%s+%s))*(%s*%s))"
- c p1 wf2 p1 p2 wf1 p2 wf1 p1 p2 wf2 p1 p2 p1 p2 wf1 wf2
- | (F12|F13) -> printf
- "(%s)*((%s*%s)*%s - ((%s+%s)*%s)*%s + (%s*%s)*%s)"
- c p1 wf2 p2 p1 p2 wf2 p1 p1 p1 wf2
- | (F21|F31) -> printf
- "(%s)*((%s*%s)*%s - ((%s+%s)*%s)*%s + (%s*%s)*%s)"
- c p2 wf1 p1 p1 p2 wf1 p2 p2 p2 wf1
- end
+ | (F23|F32) -> printf "phi_u_vv (%s, %s, %s, %s, %s)" c p1 p2 wf1 wf2
+ | (F12|F13) -> printf "v_u_phiv (%s, %s, %s, %s, %s)" c wf1 p1 p2 wf2
+ | (F21|F31) -> printf "v_u_phiv (%s, %s, %s, %s, %s)" c wf2 p2 p1 wf1
+ end
+
+ | Dim5_Scalar_Vector_Vector_TU coeff ->
+ let c = format_coupling coeff c in
+ begin match fusion with
+ | F23 -> printf "(%s)*((%s*%s)*(-(%s+%s)*%s) - (-(%s+%s)*%s)*(%s*%s))"
+ c p1 wf2 p1 p2 wf1 p1 p2 p1 wf1 wf2
+ | F32 -> printf "(%s)*((%s*%s)*(-(%s+%s)*%s) - (-(%s+%s)*%s)*(%s*%s))"
+ c p2 wf1 p1 p2 wf2 p1 p2 p2 wf1 wf2
+ | F12 -> printf "(%s)*%s*((%s*%s)*%s - (%s*%s)*%s)"
+ c wf1 p1 wf2 p2 p1 p2 wf2
+ | F21 -> printf "(%s)*%s*((%s*%s)*%s - (%s*%s)*%s)"
+ c wf2 p2 wf1 p1 p1 p2 wf1
+ | F13 -> printf "(%s)*%s*((-(%s+%s)*%s)*%s - (-(%s+%s)*%s)*%s)"
+ c wf1 p1 p2 wf2 p1 p1 p2 p1 wf2
+ | F31 -> printf "(%s)*%s*((-(%s+%s)*%s)*%s - (-(%s+%s)*%s)*%s)"
+ c wf2 p1 p2 wf1 p2 p1 p2 p2 wf1
+ end
| Dim6_Vector_Vector_Vector_T coeff ->
let c = format_coupling coeff c in
begin match fusion with
| F23 -> printf "(%s)*(%s*%s)*(%s*%s)*(%s-%s)" c p2 wf1 p1 wf2 p1 p2
| F32 -> printf "(%s)*(%s*%s)*(%s*%s)*(%s-%s)" c p1 wf2 p2 wf1 p2 p1
| (F12|F13) -> printf "(%s)*((%s+2*%s)*%s)*(-((%s+%s)*%s))*%s"
c p1 p2 wf1 p1 p2 wf2 p2
| (F21|F31) -> printf "(%s)*((-((%s+%s)*%s))*(%s+2*%s)*%s)*%s"
c p2 p1 wf1 p2 p1 wf2 p1
end
| Tensor_2_Vector_Vector coeff ->
let c = format_coupling coeff c in
begin match fusion with
| (F23|F32) -> printf "t2_vv(%s,%s,%s)" c wf1 wf2
| (F12|F13) -> printf "v_t2v(%s,%s,%s)" c wf1 wf2
| (F21|F31) -> printf "v_t2v(%s,%s,%s)" c wf2 wf1
end
| Dim5_Tensor_2_Vector_Vector_1 coeff ->
let c = format_coupling coeff c in
begin match fusion with
| (F23|F32) -> printf "t2_vv_d5_1(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2
| (F12|F13) -> printf "v_t2v_d5_1(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2
| (F21|F31) -> printf "v_t2v_d5_1(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1
end
| Dim5_Tensor_2_Vector_Vector_2 coeff ->
let c = format_coupling coeff c in
begin match fusion with
| F23 -> printf "t2_vv_d5_2(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2
| F32 -> printf "t2_vv_d5_2(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1
| (F12|F13) -> printf "v_t2v_d5_2(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2
| (F21|F31) -> printf "v_t2v_d5_2(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1
end
| Dim7_Tensor_2_Vector_Vector_T coeff ->
let c = format_coupling coeff c in
begin match fusion with
| F23 -> printf "t2_vv_d7(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2
| F32 -> printf "t2_vv_d7(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1
| (F12|F13) -> printf "v_t2v_d7(%s,%s,%s,%s,%s)" c wf1 p1 wf2 p2
| (F21|F31) -> printf "v_t2v_d7(%s,%s,%s,%s,%s)" c wf2 p2 wf1 p1
end
end
(* Flip the sign to account for the~$\mathrm{i}^2$ relative to diagrams
with only cubic couplings. *)
| V4 (vertex, fusion, constant) ->
let c = CM.constant_symbol constant
and ch1, ch2, ch3 = children3 rhs in
let wf1 = multiple_variable amplitude dictionary ch1
and wf2 = multiple_variable amplitude dictionary ch2
and wf3 = multiple_variable amplitude dictionary ch3
and p1 = momentum ch1
and p2 = momentum ch2
and p3 = momentum ch3 in
printf "@, %s " (if (F.sign rhs) < 0 then "+" else "-");
begin match vertex with
| Scalar4 coeff ->
printf "(%s*%s*%s*%s)" (format_coupling coeff c) wf1 wf2 wf3
| Scalar2_Vector2 coeff ->
let c = format_coupling coeff c in
begin match fusion with
| F134 | F143 | F234 | F243 ->
printf "%s*%s*(%s*%s)" c wf1 wf2 wf3
| F314 | F413 | F324 | F423 ->
printf "%s*%s*(%s*%s)" c wf2 wf1 wf3
| F341 | F431 | F342 | F432 ->
printf "%s*%s*(%s*%s)" c wf3 wf1 wf2
| F312 | F321 | F412 | F421 ->
printf "(%s*%s*%s)*%s" c wf2 wf3 wf1
| F231 | F132 | F241 | F142 ->
printf "(%s*%s*%s)*%s" c wf1 wf3 wf2
| F123 | F213 | F124 | F214 ->
printf "(%s*%s*%s)*%s" c wf1 wf2 wf3
end
| Vector4 contractions ->
begin match contractions with
| [] -> invalid_arg "Targets.print_current: Vector4 []"
| head :: tail ->
printf "(";
print_vector4 c wf1 wf2 wf3 fusion head;
List.iter (print_add_vector4 c wf1 wf2 wf3 fusion) tail;
printf ")"
end
| Vector4_K_Matrix_tho (disc, poles) ->
let pa, pb =
begin match fusion with
| (F341|F431|F342|F432|F123|F213|F124|F214) -> (p1, p2)
| (F134|F143|F234|F243|F312|F321|F412|F421) -> (p2, p3)
| (F314|F413|F324|F423|F132|F231|F142|F241) -> (p1, p3)
end in
printf "(%s*(%s*%s)*(%s*%s)*(%s*%s)@,*("
c p1 wf1 p2 wf2 p3 wf3;
List.iter (fun (coeff, pole) ->
printf "+%s/((%s+%s)*(%s+%s)-%s)"
(CM.constant_symbol coeff) pa pb pa pb
(CM.constant_symbol pole))
poles;
printf ")*(-%s-%s-%s))" p1 p2 p3
| Vector4_K_Matrix_jr (disc, contractions) ->
let pa, pb =
begin match disc, fusion with
| 3, (F143|F413|F142|F412|F321|F231|F324|F234) -> (p1, p2)
| 3, (F314|F341|F214|F241|F132|F123|F432|F423) -> (p2, p3)
| 3, (F134|F431|F124|F421|F312|F213|F342|F243) -> (p1, p3)
| _, (F341|F431|F342|F432|F123|F213|F124|F214) -> (p1, p2)
| _, (F134|F143|F234|F243|F312|F321|F412|F421) -> (p2, p3)
| _, (F314|F413|F324|F423|F132|F231|F142|F241) -> (p1, p3)
end in
begin match contractions with
| [] -> invalid_arg "Targets.print_current: Vector4_K_Matrix_jr []"
| head :: tail ->
printf "(";
print_vector4_km c pa pb wf1 wf2 wf3 fusion head;
List.iter (print_add_vector4_km c pa pb wf1 wf2 wf3 fusion)
tail;
printf ")"
end
| GBBG (coeff, fb, b, f) ->
Fermions.print_current_g4 (coeff, fb, b, f) c wf1 wf2 wf3
fusion
(* \begin{dubious}
In principle, [p4] could be obtained from the left hand side \ldots
\end{dubious} *)
| DScalar4 contractions ->
let p123 = Printf.sprintf "(-%s-%s-%s)" p1 p2 p3 in
begin match contractions with
| [] -> invalid_arg "Targets.print_current: DScalar4 []"
| head :: tail ->
printf "(";
print_dscalar4 c wf1 wf2 wf3 p1 p2 p3 p123 fusion head;
List.iter (print_add_dscalar4
c wf1 wf2 wf3 p1 p2 p3 p123 fusion) tail;
printf ")"
end
| DScalar2_Vector2 contractions ->
let p123 = Printf.sprintf "(-%s-%s-%s)" p1 p2 p3 in
begin match contractions with
| [] -> invalid_arg "Targets.print_current: DScalar4 []"
| head :: tail ->
printf "(";
print_dscalar2_vector2
c wf1 wf2 wf3 p1 p2 p3 p123 fusion head;
List.iter (print_add_dscalar2_vector2
c wf1 wf2 wf3 p1 p2 p3 p123 fusion) tail;
printf ")"
end
end
| Vn (_, _, _) ->
invalid_arg "Targets.print_current: n-ary fusion"
let print_propagator f p m gamma =
let minus_third = "(-1.0_" ^ !kind ^ "/3.0_" ^ !kind ^ ")" in
let w =
begin match CM.width f with
| Vanishing | Fudged -> "0.0_" ^ !kind
| Constant -> gamma
| Timelike -> "wd_tl(" ^ p ^ "," ^ gamma ^ ")"
| Running ->
failwith "Targets.Fortran: running width not yet available"
| Custom f -> f ^ "(" ^ p ^ "," ^ gamma ^ ")"
end in
match CM.propagator f with
| Prop_Scalar ->
printf "pr_phi(%s,%s,%s," p m w
| Prop_Col_Scalar ->
printf "%s * pr_phi(%s,%s,%s," minus_third p m w
| Prop_Ghost -> printf "(0,1) * pr_phi(%s, %s, %s," p m w
| Prop_Spinor ->
printf "%s(%s,%s,%s," Fermions.psi_propagator p m w
| Prop_ConjSpinor ->
printf "%s(%s,%s,%s," Fermions.psibar_propagator p m w
| Prop_Majorana ->
printf "%s(%s,%s,%s," Fermions.chi_propagator p m w
| Prop_Col_Majorana ->
printf "%s * %s(%s,%s,%s," minus_third Fermions.chi_propagator p m w
| Prop_Unitarity ->
printf "pr_unitarity(%s,%s,%s," p m w
| Prop_Col_Unitarity ->
printf "%s * pr_unitarity(%s,%s,%s," minus_third p m w
| Prop_Feynman ->
printf "pr_feynman(%s," p
| Prop_Col_Feynman ->
printf "%s * pr_feynman(%s," minus_third p
| Prop_Gauge xi ->
printf "pr_gauge(%s,%s," p (CM.gauge_symbol xi)
| Prop_Rxi xi ->
printf "pr_rxi(%s,%s,%s,%s," p m w (CM.gauge_symbol xi)
| Prop_Tensor_2 ->
printf "pr_tensor(%s,%s,%s," p m w
| Prop_Vectorspinor ->
printf "pr_grav(%s,%s,%s," p m w
| Aux_Scalar | Aux_Spinor | Aux_ConjSpinor | Aux_Majorana
| Aux_Vector | Aux_Tensor_1 -> printf "("
| Aux_Col_Vector | Aux_Col_Tensor_1 -> printf "%s * (" minus_third
| Only_Insertion -> printf "("
let print_projector f p m gamma =
let minus_third = "(-1.0_" ^ !kind ^ "/3.0_" ^ !kind ^ ")" in
match CM.propagator f with
| Prop_Scalar ->
printf "pj_phi(%s,%s," m gamma
| Prop_Col_Scalar ->
printf "%s * pj_phi(%s,%s," minus_third m gamma
| Prop_Ghost ->
printf "(0,1) * pj_phi(%s,%s," m gamma
| Prop_Spinor ->
printf "%s(%s,%s,%s," Fermions.psi_projector p m gamma
| Prop_ConjSpinor ->
printf "%s(%s,%s,%s," Fermions.psibar_projector p m gamma
| Prop_Majorana ->
printf "%s(%s,%s,%s," Fermions.chi_projector p m gamma
| Prop_Col_Majorana ->
printf "%s * %s(%s,%s,%s," minus_third Fermions.chi_projector p m gamma
| Prop_Unitarity ->
printf "pj_unitarity(%s,%s,%s," p m gamma
| Prop_Col_Unitarity ->
printf "%s * pj_unitarity(%s,%s,%s," minus_third p m gamma
| Prop_Feynman | Prop_Col_Feynman ->
invalid_arg "no on-shell Feynman propagator!"
| Prop_Gauge xi ->
invalid_arg "no on-shell massless gauge propagator!"
| Prop_Rxi xi ->
invalid_arg "no on-shell Rxi propagator!"
| Prop_Vectorspinor ->
printf "pj_grav(%s,%s,%s," p m gamma
| Prop_Tensor_2 ->
printf "pj_tensor(%s,%s,%s," p m gamma
| Aux_Scalar | Aux_Spinor | Aux_ConjSpinor | Aux_Majorana
| Aux_Vector | Aux_Tensor_1 -> printf "("
| Aux_Col_Vector | Aux_Col_Tensor_1 -> printf "%s * (" minus_third
| Only_Insertion -> printf "("
let print_gauss f p m gamma =
let minus_third = "(-1.0_" ^ !kind ^ "/3.0_" ^ !kind ^ ")" in
match CM.propagator f with
| Prop_Scalar ->
printf "pg_phi(%s,%s,%s," p m gamma
| Prop_Ghost ->
printf "(0,1) * pg_phi(%s,%s,%s," p m gamma
| Prop_Spinor ->
printf "%s(%s,%s,%s," Fermions.psi_projector p m gamma
| Prop_ConjSpinor ->
printf "%s(%s,%s,%s," Fermions.psibar_projector p m gamma
| Prop_Majorana ->
printf "%s(%s,%s,%s," Fermions.chi_projector p m gamma
| Prop_Col_Majorana ->
printf "%s * %s(%s,%s,%s," minus_third Fermions.chi_projector p m gamma
| Prop_Unitarity ->
printf "pg_unitarity(%s,%s,%s," p m gamma
| Prop_Feynman | Prop_Col_Feynman ->
invalid_arg "no on-shell Feynman propagator!"
| Prop_Gauge xi ->
invalid_arg "no on-shell massless gauge propagator!"
| Prop_Rxi xi ->
invalid_arg "no on-shell Rxi propagator!"
| Prop_Tensor_2 ->
printf "pg_tensor(%s,%s,%s," p m gamma
| Aux_Scalar | Aux_Spinor | Aux_ConjSpinor | Aux_Majorana
| Aux_Vector | Aux_Tensor_1 -> printf "("
| Only_Insertion -> printf "("
| _ -> invalid_arg "targets:print_gauss: not available"
let print_fusion_diagnostics amplitude dictionary fusion =
if warn diagnose_gauge then begin
let lhs = F.lhs fusion in
let f = F.flavor lhs
and v = variable lhs
and p = momentum lhs in
let mass = CM.mass_symbol f in
match CM.propagator f with
| Prop_Gauge _ | Prop_Feynman
| Prop_Rxi _ | Prop_Unitarity ->
printf " @[<2>%s =" v;
List.iter (print_current amplitude dictionary) (F.rhs fusion); nl();
begin match CM.goldstone f with
| None ->
printf " call omega_ward_%s(\"%s\",%s,%s,%s)"
(suffix diagnose_gauge) v mass p v; nl ()
| Some (g, phase) ->
let gv = add_tag lhs (CM.flavor_symbol g ^ "_" ^ format_p lhs) in
printf " call omega_slavnov_%s"
(suffix diagnose_gauge);
printf "(@[\"%s\",%s,%s,%s,@,%s*%s)"
v mass p v (format_constant phase) gv; nl ()
end
| _ -> ()
end
let print_fusion amplitude dictionary fusion =
let lhs = F.lhs fusion in
let f = F.flavor lhs in
printf " @[<2>%s =@, " (multiple_variable amplitude dictionary lhs);
if F.on_shell amplitude lhs then
print_projector f (momentum lhs)
(CM.mass_symbol f) (CM.width_symbol f)
else
if F.is_gauss amplitude lhs then
print_gauss f (momentum lhs)
(CM.mass_symbol f) (CM.width_symbol f)
else
print_propagator f (momentum lhs)
(CM.mass_symbol f) (CM.width_symbol f);
List.iter (print_current amplitude dictionary) (F.rhs fusion);
printf ")"; nl ()
let print_momenta seen_momenta amplitude =
List.fold_left (fun seen f ->
let wf = F.lhs f in
let p = F.momentum_list wf in
if not (PSet.mem p seen) then begin
let rhs1 = List.hd (F.rhs f) in
printf " %s = %s" (momentum wf)
(String.concat " + "
(List.map momentum (F.children rhs1))); nl ()
end;
PSet.add p seen)
seen_momenta (F.fusions amplitude)
let print_fusions dictionary fusions =
List.iter
(fun (f, amplitude) ->
print_fusion_diagnostics amplitude dictionary f;
print_fusion amplitude dictionary f)
fusions
let print_braket amplitude dictionary name braket =
let bra = F.bra braket
and ket = F.ket braket in
printf " @[<2>%s = %s@, + " name name;
begin match Fermions.reverse_braket (CM.lorentz (F.flavor bra)) with
| false ->
printf "%s*(@," (multiple_variable amplitude dictionary bra);
List.iter (print_current amplitude dictionary) ket;
printf ")"
| true ->
printf "(@,";
List.iter (print_current amplitude dictionary) ket;
printf ")*%s" (multiple_variable amplitude dictionary bra)
end; nl ()
(* \begin{equation}
\ii T = \ii^{\#\text{vertices}}\ii^{\#\text{propagators}} \cdots
= \ii^{n-2}\ii^{n-3} \cdots
= -\ii(-1)^n \cdots
\end{equation} *)
(* \begin{dubious}
[tho:] we write some brakets twice using different names. Is it useful
to cache them?
\end{dubious} *)
let print_brakets dictionary amplitude =
let name = flavors_symbol (flavors amplitude) in
printf " %s = 0" name; nl ();
List.iter (print_braket amplitude dictionary name) (F.brakets amplitude);
let n = List.length (F.externals amplitude) in
if n mod 2 = 0 then begin
printf " @[<2>%s =@, - %s ! %d vertices, %d propagators"
name name (n - 2) (n - 3); nl ()
end else begin
printf " ! %s = %s ! %d vertices, %d propagators"
name name (n - 2) (n - 3); nl ()
end;
let s = F.symmetry amplitude in
if s > 1 then
printf " @[<2>%s =@, %s@, / sqrt(%d.0_%s) ! symmetry factor" name name s !kind
else
printf " ! unit symmetry factor";
nl ()
let print_incoming wf =
let p = momentum wf
and s = spin wf
and f = F.flavor wf in
let m = CM.mass_symbol f in
match CM.lorentz f with
| Scalar -> printf "1"
| BRS Scalar -> printf "(0,-1) * (%s * %s - %s**2)" p p m
| Spinor ->
printf "%s (%s, - %s, %s)" Fermions.psi_incoming m p s
| BRS Spinor ->
printf "%s (%s, - %s, %s)" Fermions.brs_psi_incoming m p s
| ConjSpinor ->
printf "%s (%s, - %s, %s)" Fermions.psibar_incoming m p s
| BRS ConjSpinor ->
printf "%s (%s, - %s, %s)" Fermions.brs_psibar_incoming m p s
| Majorana ->
printf "%s (%s, - %s, %s)" Fermions.chi_incoming m p s
| Maj_Ghost -> printf "ghost (%s, - %s, %s)" m p s
| BRS Majorana ->
printf "%s (%s, - %s, %s)" Fermions.brs_chi_incoming m p s
| Vector | Massive_Vector ->
printf "eps (%s, - %s, %s)" m p s
(*i | Ward_Vector -> printf "%s" p i*)
| BRS Vector | BRS Massive_Vector -> printf
"(0,1) * (%s * %s - %s**2) * eps (%s, -%s, %s)" p p m m p s
| Vectorspinor | BRS Vectorspinor ->
printf "%s (%s, - %s, %s)" Fermions.grav_incoming m p s
| Tensor_1 -> invalid_arg "Tensor_1 only internal"
| Tensor_2 -> printf "eps2 (%s, - %s, %s)" m p s
| _ -> invalid_arg "no such BRST transformations"
let print_outgoing wf =
let p = momentum wf
and s = spin wf
and f = F.flavor wf in
let m = CM.mass_symbol f in
match CM.lorentz f with
| Scalar -> printf "1"
| BRS Scalar -> printf "(0,-1) * (%s * %s - %s**2)" p p m
| Spinor ->
printf "%s (%s, %s, %s)" Fermions.psi_outgoing m p s
| BRS Spinor ->
printf "%s (%s, %s, %s)" Fermions.brs_psi_outgoing m p s
| ConjSpinor ->
printf "%s (%s, %s, %s)" Fermions.psibar_outgoing m p s
| BRS ConjSpinor ->
printf "%s (%s, %s, %s)" Fermions.brs_psibar_outgoing m p s
| Majorana ->
printf "%s (%s, %s, %s)" Fermions.chi_outgoing m p s
| BRS Majorana ->
printf "%s (%s, %s, %s)" Fermions.brs_chi_outgoing m p s
| Maj_Ghost -> printf "ghost (%s, %s, %s)" m p s
| Vector | Massive_Vector ->
printf "conjg (eps (%s, %s, %s))" m p s
(*i | Ward_Vector -> printf "%s" p i*)
| BRS Vector | BRS Massive_Vector -> printf
"(0,1) * (%s*%s-%s**2) * (conjg (eps (%s, %s, %s)))" p p m m p s
| Vectorspinor | BRS Vectorspinor ->
printf "%s (%s, %s, %s)" Fermions.grav_incoming m p s
| Tensor_1 -> invalid_arg "Tensor_1 only internal"
| Tensor_2 -> printf "conjg (eps2 (%s, %s, %s))" m p s
| BRS _ -> invalid_arg "no such BRST transformations"
let twice_spin wf =
match CM.lorentz (F.flavor wf) with
| Scalar | BRS Scalar -> "0"
| Spinor | ConjSpinor | Majorana | Maj_Ghost | Vectorspinor
| BRS Spinor | BRS ConjSpinor | BRS Majorana | BRS Vectorspinor -> "1"
| Vector | BRS Vector | Massive_Vector | BRS Massive_Vector -> "2"
| Tensor_1 -> "2"
| Tensor_2 -> "4"
| BRS _ -> invalid_arg "Targets.twice_spin: no such BRST transformation"
let print_argument_diagnostics amplitude =
let externals = (F.externals amplitude) in
let n = List.length externals
and masses = List.map (fun wf -> CM.mass_symbol (F.flavor wf)) externals in
if warn diagnose_arguments then begin
printf " call omega_check_arguments_%s (%d, k)"
(suffix diagnose_arguments) n; nl ()
end;
if warn diagnose_momenta then begin
printf " @[<2>call omega_check_momenta_%s ((/ "
(suffix diagnose_momenta);
print_list masses;
printf " /), k)"; nl ()
end
let print_external_momenta amplitude =
let externals =
List.combine
(F.externals amplitude)
(List.map (fun _ -> true) (F.incoming amplitude) @
List.map (fun _ -> false) (F.outgoing amplitude)) in
List.iter (fun (wf, incoming) ->
if incoming then
printf " %s = - k(:,%d) ! incoming"
(momentum wf) (ext_momentum wf)
else
printf " %s = k(:,%d) ! outgoing"
(momentum wf) (ext_momentum wf); nl ()) externals
let print_externals seen_wfs amplitude =
let externals =
List.combine
(F.externals amplitude)
(List.map (fun _ -> true) (F.incoming amplitude) @
List.map (fun _ -> false) (F.outgoing amplitude)) in
List.fold_left (fun seen (wf, incoming) ->
if not (WFSet.mem wf seen) then begin
printf " @[<2>%s =@, " (variable wf);
(if incoming then print_incoming else print_outgoing) wf; nl ()
end;
WFSet.add wf seen) seen_wfs externals
let flavors_to_string flavors =
String.concat " " (List.map CM.flavor_to_string flavors)
let process_to_string amplitude =
flavors_to_string (F.incoming amplitude) ^ " -> " ^
flavors_to_string (F.outgoing amplitude)
let flavors_sans_color_to_string flavors =
String.concat " " (List.map M.flavor_to_string flavors)
let process_sans_color_to_string (fin, fout) =
flavors_sans_color_to_string fin ^ " -> " ^
flavors_sans_color_to_string fout
let print_fudge_factor amplitude =
let name = flavors_symbol (flavors amplitude) in
List.iter (fun wf ->
let p = momentum wf
and f = F.flavor wf in
match CM.width f with
| Fudged ->
let m = CM.mass_symbol f
and w = CM.width_symbol f in
printf " if (%s > 0.0_%s) then" w !kind; nl ();
printf " @[<2>%s = %s@ * (%s*%s - %s**2)"
name name p p m;
printf "@ / cmplx (%s*%s - %s**2, %s*%s, kind=%s)"
p p m m w !kind; nl();
printf " end if"; nl ()
| _ -> ()) (F.s_channel amplitude)
let num_helicities amplitudes =
List.length (CF.helicities amplitudes)
(* \thocwmodulesubsection{Spin, Flavor \&\ Color Tables} *)
(* The following abomination is required to keep the number of continuation
lines as low as possible. FORTRAN77-style \texttt{DATA} statements
are actually a bit nicer here, but they are nor available for
\emph{constant} arrays. *)
(* \begin{dubious}
We used to have a more elegent design with a sentinel~0 added to each
initializer, but some revisions of the Compaq/Digital Compiler have a
bug that causes it to reject this variant.
\end{dubious} *)
(* \begin{dubious}
The actual table writing code using \texttt{reshape} should be factored,
since it's the same algorithm every time.
\end{dubious} *)
let print_integer_parameter name value =
printf " @[<2>integer, parameter :: %s = %d" name value; nl ()
let print_real_parameter name value =
printf " @[<2>real(kind=%s), parameter :: %s = %d"
!kind name value; nl ()
let print_logical_parameter name value =
printf " @[<2>logical, parameter :: %s = .%s."
name (if value then "true" else "false"); nl ()
let num_particles_in amplitudes =
match CF.flavors amplitudes with
| [] -> 0
| (fin, _) :: _ -> List.length fin
let num_particles_out amplitudes =
match CF.flavors amplitudes with
| [] -> 0
| (_, fout) :: _ -> List.length fout
let num_particles amplitudes =
match CF.flavors amplitudes with
| [] -> 0
| (fin, fout) :: _ -> List.length fin + List.length fout
module CFlow = Color.Flow
let num_color_flows amplitudes =
List.length (CF.color_flows amplitudes)
let num_color_indices_default = 2 (* Standard model *)
let num_color_indices amplitudes =
try CFlow.rank (List.hd (CF.color_flows amplitudes)) with _ -> num_color_indices_default
let color_to_string c =
"(" ^ (String.concat "," (List.map (Printf.sprintf "%3d") c)) ^ ")"
let cflow_to_string cflow =
String.concat " " (List.map color_to_string (CFlow.in_to_lists cflow)) ^ " -> " ^
String.concat " " (List.map color_to_string (CFlow.out_to_lists cflow))
let protected = ""
let protected = ", protected" (* Fortran 2003! *)
let print_spin_table_old abbrev name = function
| [] ->
printf " @[<2>integer, dimension(n_prt,0) ::";
printf "@ table_spin_%s" name; nl ()
| _ :: tuples' as tuples ->
ignore (List.fold_left (fun i (tuple1, tuple2) ->
printf " @[<2>integer, dimension(n_prt), parameter, private ::";
printf "@ %s%04d = (/ %s /)" abbrev i
(String.concat ", " (List.map (Printf.sprintf "%2d") (tuple1 @ tuple2)));
nl (); succ i) 1 tuples);
printf
" @[<2>integer, dimension(n_prt,n_hel), parameter ::";
printf "@ table_spin_%s =@ reshape ( (/" name;
printf "@ %s%04d" abbrev 1;
ignore (List.fold_left (fun i tuple ->
printf ",@ %s%04d" abbrev i; succ i) 2 tuples');
printf "@ /), (/ n_prt, n_hel /) )"; nl ()
let print_spin_table name tuples =
printf " @[<2>integer, dimension(n_prt,n_hel), save%s :: table_spin_%s"
protected name; nl();
match tuples with
| [] -> ()
| _ ->
ignore (List.fold_left (fun i (tuple1, tuple2) ->
printf " @[<2>data table_spin_%s(:,%4d) / %s /" name i
(String.concat ", " (List.map (Printf.sprintf "%2d") (tuple1 @ tuple2)));
nl (); succ i) 1 tuples)
let print_spin_tables amplitudes =
(* [print_spin_table_old "s" "states_old" (CF.helicities amplitudes);] *)
print_spin_table "states" (CF.helicities amplitudes);
nl ()
let print_flavor_table_old n abbrev name = function
| [] ->
printf " @[<2>integer, dimension(n_prt,0) ::";
printf "@ table_flavor_%s" name; nl ()
| _ :: tuples' as tuples ->
ignore (List.fold_left (fun i tuple ->
printf
" @[<2>integer, dimension(n_prt), parameter, private ::";
printf "@ %s%04d = (/ %s /) ! %s" abbrev i
(String.concat ", "
(List.map (fun f -> Printf.sprintf "%3d" (M.pdg f)) tuple))
(String.concat " " (List.map M.flavor_to_string tuple));
nl (); succ i) 1 tuples);
printf
" @[<2>integer, dimension(n_prt,n_flv), parameter ::";
printf "@ table_flavor_%s =@ reshape ( (/" name;
printf "@ %s%04d" abbrev 1;
ignore (List.fold_left (fun i tuple ->
printf ",@ %s%04d" abbrev i; succ i) 2 tuples');
printf "@ /), (/ n_prt, n_flv /) )"; nl ()
let print_flavor_table n name tuples =
printf " @[<2>integer, dimension(n_prt,n_flv), save%s :: table_flavor_%s"
protected name; nl();
match tuples with
| [] -> ()
| _ ->
ignore (List.fold_left (fun i tuple ->
printf " @[<2>data table_flavor_%s(:,%4d) / %s / ! %s" name i
(String.concat ", "
(List.map (fun f -> Printf.sprintf "%3d" (M.pdg f)) tuple))
(String.concat " " (List.map M.flavor_to_string tuple));
nl (); succ i) 1 tuples)
let print_flavor_tables amplitudes =
let n = num_particles amplitudes in
(* [print_flavor_table_old n "f" "states_old"
(List.map (fun (fin, fout) -> fin @ fout) (CF.flavors amplitudes));] *)
print_flavor_table n "states"
(List.map (fun (fin, fout) -> fin @ fout) (CF.flavors amplitudes));
nl ()
let num_flavors amplitudes =
List.length (CF.flavors amplitudes)
let print_color_flows_table_old abbrev = function
| [] ->
printf " @[<2>integer, dimension(n_cindex, n_prt, n_cflow) ::";
printf "@ table_color_flows"; nl ()
| _ :: tuples' as tuples ->
ignore (List.fold_left (fun i tuple ->
printf
" @[<2>integer, dimension(n_cindex, n_prt), parameter, private ::";
printf "@ %s%04d = reshape ( (/ " abbrev i;
begin match CFlow.to_lists tuple with
| [] -> ()
| cf1 :: cfn ->
printf "@ %s" (String.concat "," (List.map string_of_int cf1));
List.iter (function cf ->
printf ",@ %s" (String.concat "," (List.map string_of_int cf))) cfn
end;
printf "@ /),@ (/ n_cindex, n_prt /) )";
nl (); succ i) 1 tuples);
printf
" @[<2>integer, dimension(n_cindex, n_prt, n_cflow), parameter ::";
printf "@ table_color_flows_old =@ reshape ( (/";
printf "@ %s%04d" abbrev 1;
ignore (List.fold_left (fun i tuple ->
printf ",@ %s%04d" abbrev i; succ i) 2 tuples');
printf "@ /),@ (/ n_cindex, n_prt, n_cflow /) )"; nl ()
let print_ghost_flags_table_old abbrev = function
| [] ->
printf " @[<2>logical, dimension(n_prt, n_cflow) ::";
printf "@ table_ghost_flags"; nl ()
| _ :: tuples' as tuples ->
ignore (List.fold_left (fun i tuple ->
printf
" @[<2>logical, dimension(n_prt), parameter, private ::";
printf "@ %s%04d = (/ " abbrev i;
begin match CFlow.ghost_flags tuple with
| [] -> ()
| gf1 :: gfn ->
printf "@ %s" (if gf1 then "T" else "F");
List.iter (function gf -> printf ",@ %s" (if gf then "T" else "F")) gfn
end;
printf "@ /)";
nl (); succ i) 1 tuples);
printf
" @[<2>logical, dimension(n_prt, n_cflow), parameter ::";
printf "@ table_ghost_flags_old =@ reshape ( (/";
printf "@ %s%04d" abbrev 1;
ignore (List.fold_left (fun i tuple ->
printf ",@ %s%04d" abbrev i; succ i) 2 tuples');
printf "@ /),@ (/ n_prt, n_cflow /) )"; nl ()
let print_color_flows_table tuples =
printf
" @[<2>integer, dimension(n_cindex,n_prt,n_cflow), save%s :: table_color_flows"
protected; nl ();
match tuples with
| [] -> ()
| _ :: tuples' as tuples ->
ignore (List.fold_left (fun i tuple ->
begin match CFlow.to_lists tuple with
| [] -> ()
| cf1 :: cfn ->
printf " @[<2>data table_color_flows(:,:,%4d) /" i;
printf "@ %s" (String.concat "," (List.map string_of_int cf1));
List.iter (function cf ->
printf ",@ %s" (String.concat "," (List.map string_of_int cf))) cfn;
printf "@ /"; nl ()
end;
succ i) 1 tuples)
let print_ghost_flags_table tuples =
printf
" @[<2>logical, dimension(n_prt,n_cflow), save%s :: table_ghost_flags"
protected; nl ();
match tuples with
| [] -> ()
| _ ->
ignore (List.fold_left (fun i tuple ->
begin match CFlow.ghost_flags tuple with
| [] -> ()
| gf1 :: gfn ->
printf " @[<2>data table_ghost_flags(:,%4d) /" i;
printf "@ %s" (if gf1 then "T" else "F");
List.iter (function gf -> printf ",@ %s" (if gf then "T" else "F")) gfn;
printf " /";
nl ()
end;
succ i) 1 tuples)
let format_power_of x
{ Color.Flow.num = num; Color.Flow.den = den; Color.Flow.power = pwr } =
match num, den, pwr with
| _, 0, _ -> invalid_arg "format_power_of: zero denominator"
| 0, _, _ -> "+zero"
| 1, 1, 0 | -1, -1, 0 -> "+one"
| -1, 1, 0 | 1, -1, 0 -> "-one"
| 1, 1, 1 | -1, -1, 1 -> "+" ^ x
| -1, 1, 1 | 1, -1, 1 -> "-" ^ x
| 1, 1, -1 | -1, -1, -1 -> "+1/" ^ x
| -1, 1, -1 | 1, -1, -1 -> "-1/" ^ x
| 1, 1, p | -1, -1, p ->
"+" ^ (if p > 0 then "" else "1/") ^ x ^ "**" ^ string_of_int (abs p)
| -1, 1, p | 1, -1, p ->
"-" ^ (if p > 0 then "" else "1/") ^ x ^ "**" ^ string_of_int (abs p)
| n, 1, 0 ->
(if n < 0 then "-" else "+") ^ string_of_int (abs n) ^ ".0_" ^ !kind
| n, d, 0 ->
(if n * d < 0 then "-" else "+") ^
string_of_int (abs n) ^ ".0_" ^ !kind ^ "/" ^
string_of_int (abs d)
| n, 1, 1 ->
(if n < 0 then "-" else "+") ^ string_of_int (abs n) ^ "*" ^ x
| n, 1, -1 ->
(if n < 0 then "-" else "+") ^ string_of_int (abs n) ^ "/" ^ x
| n, d, 1 ->
(if n * d < 0 then "-" else "+") ^
string_of_int (abs n) ^ ".0_" ^ !kind ^ "/" ^
string_of_int (abs d) ^ "*" ^ x
| n, d, -1 ->
(if n * d < 0 then "-" else "+") ^
string_of_int (abs n) ^ ".0_" ^ !kind ^ "/" ^
string_of_int (abs d) ^ "/" ^ x
| n, 1, p ->
(if n < 0 then "-" else "+") ^ string_of_int (abs n) ^
(if p > 0 then "*" else "/") ^ x ^ "**" ^ string_of_int (abs p)
| n, d, p ->
(if n * d < 0 then "-" else "+") ^
string_of_int (abs n) ^ ".0_" ^ !kind ^ "/" ^
string_of_int (abs d) ^
(if p > 0 then "*" else "/") ^ x ^ "**" ^ string_of_int (abs p)
let format_powers_of x = function
| [] -> "zero"
| powers -> String.concat "" (List.map (format_power_of x) powers)
let print_color_factor_table_old table =
let n_cflow = Array.length table in
let n_cfactors = ref 0 in
for c1 = 0 to pred n_cflow do
for c2 = 0 to pred n_cflow do
match table.(c1).(c2) with
| [] -> ()
| _ -> incr n_cfactors
done
done;
print_integer_parameter "n_cfactors" !n_cfactors;
if n_cflow <= 0 then begin
printf " @[<2>type(%s), dimension(n_cfactors) ::"
omega_color_factor_abbrev;
printf "@ table_color_factors"; nl ()
end else begin
printf
" @[<2>type(%s), dimension(n_cfactors), parameter ::"
omega_color_factor_abbrev;
printf "@ table_color_factors = (/@ ";
let comma = ref "" in
for c1 = 0 to pred n_cflow do
for c2 = 0 to pred n_cflow do
match table.(c1).(c2) with
| [] -> ()
| cf ->
printf "%s@ %s(%d,%d,%s)" !comma omega_color_factor_abbrev
(succ c1) (succ c2) (format_powers_of nc_parameter cf);
comma := ","
done
done;
printf "@ /)"; nl ()
end
(* \begin{dubious}
We can optimize the following slightly by reusing common color factor [parameter]s.
\end{dubious} *)
let print_color_factor_table table =
let n_cflow = Array.length table in
let n_cfactors = ref 0 in
for c1 = 0 to pred n_cflow do
for c2 = 0 to pred n_cflow do
match table.(c1).(c2) with
| [] -> ()
| _ -> incr n_cfactors
done
done;
print_integer_parameter "n_cfactors" !n_cfactors;
printf " @[<2>type(%s), dimension(n_cfactors), save%s ::"
omega_color_factor_abbrev protected;
printf "@ table_color_factors"; nl ();
let i = ref 1 in
if n_cflow > 0 then begin
for c1 = 0 to pred n_cflow do
for c2 = 0 to pred n_cflow do
match table.(c1).(c2) with
| [] -> ()
| cf ->
printf " @[<2>real(kind=%s), parameter, private :: color_factor_%06d = %s"
!kind !i (format_powers_of nc_parameter cf);
nl ();
printf " @[<2>data table_color_factors(%6d) / %s(%d,%d,color_factor_%06d) /"
!i omega_color_factor_abbrev (succ c1) (succ c2) !i;
incr i;
nl ();
done
done
end
let print_color_tables amplitudes =
let cflows = CF.color_flows amplitudes
and cfactors = CF.color_factors amplitudes in
(* [print_color_flows_table_old "c" cflows; nl ();] *)
print_color_flows_table cflows; nl ();
(* [print_ghost_flags_table_old "g" cflows; nl ();] *)
print_ghost_flags_table cflows; nl ();
(* [print_color_factor_table_old cfactors; nl ();] *)
print_color_factor_table cfactors; nl ()
let option_to_logical = function
| Some _ -> "T"
| None -> "F"
let print_flavor_color_table_old abbrev n_flv n_cflow table =
if n_flv <= 0 or n_cflow <= 0 then begin
printf " @[<2>logical, dimension(n_flv, n_cflow) ::";
printf "@ flv_col_is_allowed"; nl ()
end else begin
for c = 0 to pred n_cflow do
printf
" @[<2>logical, dimension(n_flv), parameter, private ::";
printf "@ %s%04d = (/@ %s" abbrev (succ c) (option_to_logical table.(0).(c));
for f = 1 to pred n_flv do
printf ",@ %s" (option_to_logical table.(f).(c))
done;
printf "@ /)"; nl ()
done;
printf
" @[<2>logical, dimension(n_flv, n_cflow), parameter ::";
printf "@ flv_col_is_allowed_old =@ reshape ( (/@ %s%04d" abbrev 1;
for c = 1 to pred n_cflow do
printf ",@ %s%04d" abbrev (succ c)
done;
printf "@ /),@ (/ n_flv, n_cflow /) )"; nl ()
end
let print_flavor_color_table n_flv n_cflow table =
printf
" @[<2>logical, dimension(n_flv, n_cflow), save%s :: @ flv_col_is_allowed"
protected; nl ();
if n_flv > 0 then begin
for c = 0 to pred n_cflow do
printf
" @[<2>data flv_col_is_allowed(:,%4d) /" (succ c);
printf "@ %s" (option_to_logical table.(0).(c));
for f = 1 to pred n_flv do
printf ",@ %s" (option_to_logical table.(f).(c))
done;
printf "@ /"; nl ()
done;
end
let print_amplitude_table a =
(* [print_flavor_color_table_old "a"
(num_flavors a) (List.length (CF.color_flows a)) (CF.process_table a);
nl ();] *)
print_flavor_color_table
(num_flavors a) (List.length (CF.color_flows a)) (CF.process_table a);
nl ();
printf
" @[<2>complex(kind=%s), dimension(n_flv, n_cflow, n_hel), save :: amp" !kind;
nl ();
nl ()
let print_helicity_selection_table () =
printf " @[<2>logical, dimension(n_hel), save :: ";
printf "hel_is_allowed = T"; nl();
printf " @[<2>real(kind=%s), dimension(n_hel), save :: " !kind;
printf "hel_max_abs = 0"; nl ();
printf " @[<2>real(kind=%s), save :: " !kind;
printf "hel_sum_abs = 0, ";
printf "hel_threshold = 1E10"; nl ();
printf " @[<2>integer, save :: ";
printf "hel_count = 0, ";
printf "hel_cutoff = 100"; nl ();
printf " @[<2>integer :: ";
printf "i"; nl ();
printf " @[<2>integer, save, dimension(n_hel) :: ";
printf "hel_map = (/(i, i = 1, n_hel)/)"; nl ();
printf " @[<2>integer, save :: hel_finite = n_hel"; nl ();
nl ()
(* \thocwmodulesubsection{Optional MD5 sum function} *)
let print_md5sum_functions = function
| Some s ->
printf " @[<5>"; if !fortran95 then printf "pure ";
printf "function md5sum ()"; nl ();
printf " character(len=32) :: md5sum"; nl ();
printf " ! DON'T EVEN THINK of modifying the following line!"; nl ();
printf " md5sum = \"%s\"" s; nl ();
printf " end function md5sum"; nl ();
nl ()
| None -> ()
(* \thocwmodulesubsection{Maintenance \&\ Inquiry Functions} *)
let print_maintenance_functions amplitudes =
if !whizard then begin
printf " subroutine init (par)"; nl ();
printf " real(kind=%s), dimension(*), intent(in) :: par" !kind; nl ();
printf " call import_from_whizard (par)"; nl ();
printf " end subroutine init"; nl ();
nl ();
printf " subroutine final ()"; nl ();
printf " end subroutine final"; nl ();
nl ();
printf " subroutine update_alpha_s (alpha_s)"; nl ();
printf " real(kind=%s), intent(in) :: alpha_s" !kind; nl ();
printf " call model_update_alpha_s (alpha_s)"; nl ();
printf " end subroutine update_alpha_s"; nl ();
nl ()
end
let print_inquiry_function_openmp () = begin
printf " pure function openmp_supported () result (status)"; nl ();
printf " logical :: status"; nl ();
printf " status = %s" (if !openmp then ".true." else ".false."); nl ();
printf " end function openmp_supported"; nl ();
nl ()
end
let print_inquiry_function_declarations name =
printf " @[<2>public :: number_%s,@ %s" name name;
nl ()
let print_numeric_inquiry_functions () =
printf " @[<5>"; if !fortran95 then printf "pure ";
printf "function number_particles_in () result (n)"; nl ();
printf " integer :: n"; nl ();
printf " n = n_in"; nl ();
printf " end function number_particles_in"; nl ();
nl ();
printf " @[<5>"; if !fortran95 then printf "pure ";
printf "function number_particles_out () result (n)"; nl ();
printf " integer :: n"; nl ();
printf " n = n_out"; nl ();
printf " end function number_particles_out"; nl ();
nl ()
let print_numeric_inquiry_functions (f, v) =
printf " @[<5>"; if !fortran95 then printf "pure ";
printf "function %s () result (n)" f; nl ();
printf " integer :: n"; nl ();
printf " n = %s" v; nl ();
printf " end function %s" f; nl ();
nl ()
let print_inquiry_functions name =
printf " @[<5>"; if !fortran95 then printf "pure ";
printf "function number_%s () result (n)" name; nl ();
printf " integer :: n"; nl ();
printf " n = size (table_%s, dim=2)" name; nl ();
printf " end function number_%s" name; nl ();
nl ();
printf " @[<5>"; if !fortran95 then printf "pure ";
printf "subroutine %s (a)" name; nl ();
printf " integer, dimension(:,:), intent(out) :: a"; nl ();
printf " a = table_%s" name; nl ();
printf " end subroutine %s" name; nl ();
nl ()
let print_color_flows () =
printf " @[<5>"; if !fortran95 then printf "pure ";
printf "function number_color_indices () result (n)"; nl ();
printf " integer :: n"; nl ();
printf " n = size (table_color_flows, dim=1)"; nl ();
printf " end function number_color_indices"; nl ();
nl ();
printf " @[<5>"; if !fortran95 then printf "pure ";
printf "function number_color_flows () result (n)"; nl ();
printf " integer :: n"; nl ();
printf " n = size (table_color_flows, dim=3)"; nl ();
printf " end function number_color_flows"; nl ();
nl ();
printf " @[<5>"; if !fortran95 then printf "pure ";
printf "subroutine color_flows (a, g)"; nl ();
printf " integer, dimension(:,:,:), intent(out) :: a"; nl ();
printf " logical, dimension(:,:), intent(out) :: g"; nl ();
printf " a = table_color_flows"; nl ();
printf " g = table_ghost_flags"; nl ();
printf " end subroutine color_flows"; nl ();
nl ()
let print_color_factors () =
printf " @[<5>"; if !fortran95 then printf "pure ";
printf "function number_color_factors () result (n)"; nl ();
printf " integer :: n"; nl ();
printf " n = size (table_color_factors)"; nl ();
printf " end function number_color_factors"; nl ();
nl ();
printf " @[<5>"; if !fortran95 then printf "pure ";
printf "subroutine color_factors (cf)"; nl ();
printf " type(%s), dimension(:), intent(out) :: cf"
omega_color_factor_abbrev; nl ();
printf " cf = table_color_factors"; nl ();
printf " end subroutine color_factors"; nl ();
nl ();
printf " @[<5>"; if !fortran95 then printf "pure ";
printf "function color_sum (flv, hel) result (amp2)"; nl ();
printf " integer, intent(in) :: flv, hel"; nl ();
printf " real(kind=%s) :: amp2" !kind; nl ();
printf " amp2 = real (omega_color_sum (flv, hel, amp, table_color_factors))"; nl ();
printf " end function color_sum"; nl ();
nl ()
let print_dispatch_functions () =
printf " @[<5>";
printf "subroutine new_event (p)"; nl ();
printf " real(kind=%s), dimension(0:3,*), intent(in) :: p" !kind; nl ();
printf " logical :: mask_dirty"; nl ();
printf " integer :: hel"; nl ();
printf " call calculate_amplitudes (amp, p, hel_is_allowed)"; nl ();
printf " if ((hel_threshold .gt. 0) .and. (hel_count .le. hel_cutoff)) then"; nl ();
printf " call @[<3>omega_update_helicity_selection@ (hel_count,@ amp,@ ";
printf "hel_max_abs,@ hel_sum_abs,@ hel_is_allowed,@ hel_threshold,@ hel_cutoff,@ mask_dirty)"; nl ();
printf " if (mask_dirty) then"; nl ();
printf " hel_finite = 0"; nl ();
printf " do hel = 1, n_hel"; nl ();
printf " if (hel_is_allowed(hel)) then"; nl ();
printf " hel_finite = hel_finite + 1"; nl ();
printf " hel_map(hel_finite) = hel"; nl ();
printf " end if"; nl ();
printf " end do"; nl ();
printf " end if"; nl ();
printf " end if"; nl();
printf " end subroutine new_event"; nl ();
nl ();
printf " @[<5>";
printf "subroutine reset_helicity_selection (threshold, cutoff)"; nl ();
printf " real(kind=%s), intent(in) :: threshold" !kind; nl ();
printf " integer, intent(in) :: cutoff"; nl ();
printf " integer :: i"; nl ();
printf " hel_is_allowed = T"; nl ();
printf " hel_max_abs = 0"; nl ();
printf " hel_sum_abs = 0"; nl ();
printf " hel_count = 0"; nl ();
printf " hel_threshold = threshold"; nl ();
printf " hel_cutoff = cutoff"; nl ();
printf " hel_map = (/(i, i = 1, n_hel)/)"; nl ();
printf " hel_finite = n_hel"; nl ();
printf " end subroutine reset_helicity_selection"; nl ();
nl ();
printf " @[<5>"; if !fortran95 then printf "pure ";
printf "function is_allowed (flv, hel, col) result (yorn)"; nl ();
printf " logical :: yorn"; nl ();
printf " integer, intent(in) :: flv, hel, col"; nl ();
printf " yorn = hel_is_allowed(hel) .and. ";
printf "flv_col_is_allowed(flv,col)"; nl ();
printf " end function is_allowed"; nl ();
nl ();
printf " @[<5>"; if !fortran95 then printf "pure ";
printf "function get_amplitude (flv, hel, col) result (amp_result)"; nl ();
printf " complex(kind=%s) :: amp_result" !kind; nl ();
printf " integer, intent(in) :: flv, hel, col"; nl ();
printf " amp_result = amp(flv, col, hel)"; nl ();
printf " end function get_amplitude"; nl ();
nl ()
(* \thocwmodulesubsection{Main Function} *)
let format_power_of_nc
{ Color.Flow.num = num; Color.Flow.den = den; Color.Flow.power = pwr } =
match num, den, pwr with
| _, 0, _ -> invalid_arg "format_power_of_nc: zero denominator"
| 0, _, _ -> ""
| 1, 1, 0 | -1, -1, 0 -> "+ 1"
| -1, 1, 0 | 1, -1, 0 -> "- 1"
| 1, 1, 1 | -1, -1, 1 -> "+ N"
| -1, 1, 1 | 1, -1, 1 -> "- N"
| 1, 1, -1 | -1, -1, -1 -> "+ 1/N"
| -1, 1, -1 | 1, -1, -1 -> "- 1/N"
| 1, 1, p | -1, -1, p ->
"+ " ^ (if p > 0 then "" else "1/") ^ "N^" ^ string_of_int (abs p)
| -1, 1, p | 1, -1, p ->
"- " ^ (if p > 0 then "" else "1/") ^ "N^" ^ string_of_int (abs p)
| n, 1, 0 ->
(if n < 0 then "- " else "+ ") ^ string_of_int (abs n)
| n, d, 0 ->
(if n * d < 0 then "- " else "+ ") ^
string_of_int (abs n) ^ "/" ^ string_of_int (abs d)
| n, 1, 1 ->
(if n < 0 then "- " else "+ ") ^ string_of_int (abs n) ^ "N"
| n, 1, -1 ->
(if n < 0 then "- " else "+ ") ^ string_of_int (abs n) ^ "/N"
| n, d, 1 ->
(if n * d < 0 then "- " else "+ ") ^
string_of_int (abs n) ^ "/" ^ string_of_int (abs d) ^ "N"
| n, d, -1 ->
(if n * d < 0 then "- " else "+ ") ^
string_of_int (abs n) ^ "/" ^ string_of_int (abs d) ^ "/N"
| n, 1, p ->
(if n < 0 then "- " else "+ ") ^ string_of_int (abs n) ^
(if p > 0 then "*" else "/") ^ "N^" ^ string_of_int (abs p)
| n, d, p ->
(if n * d < 0 then "- " else "+ ") ^ string_of_int (abs n) ^ "/" ^
string_of_int (abs d) ^ (if p > 0 then "*" else "/") ^ "N^" ^ string_of_int (abs p)
let format_powers_of_nc = function
| [] -> "0"
| powers -> String.concat " " (List.map format_power_of_nc powers)
let print_description cmdline amplitudes () =
printf "! File generated automatically by O'Mega"; nl();
printf "!"; nl();
printf "! %s" cmdline; nl();
printf "!"; nl();
printf "! with all scattering amplitudes for the process(es)"; nl ();
printf "!"; nl ();
printf "! flavor combinations:"; nl ();
printf "!"; nl ();
ThoList.iteri
(fun i process ->
printf "! %3d: %s" i (process_sans_color_to_string process); nl ())
1 (CF.flavors amplitudes);
printf "!"; nl ();
printf "! color flows:"; nl ();
printf "!"; nl ();
ThoList.iteri
(fun i cflow ->
printf "! %3d: %s" i (cflow_to_string cflow); nl ())
1 (CF.color_flows amplitudes);
printf "!"; nl ();
printf "! NB: i.g. not all color flows contribute to all flavor"; nl ();
printf "! combinations. Consult the array FLV_COL_IS_ALLOWED"; nl ();
printf "! below for the allowed combinations."; nl ();
printf "!"; nl ();
printf "! Color Factors:"; nl ();
printf "!"; nl ();
let cfactors = CF.color_factors amplitudes in
for c1 = 0 to pred (Array.length cfactors) do
for c2 = 0 to c1 do
match cfactors.(c1).(c2) with
| [] -> ()
| cfactor ->
printf "! (%3d,%3d): %s"
(succ c1) (succ c2) (format_powers_of_nc cfactor); nl ()
done
done;
printf "!"; nl ();
printf "! vanishing or redundant flavor combinations:"; nl ();
printf "!"; nl ();
List.iter (fun process ->
printf "! %s" (process_sans_color_to_string process); nl ())
(CF.vanishing_flavors amplitudes);
printf "!"; nl ();
begin
match CF.constraints amplitudes with
| None -> ()
| Some s ->
printf
"! diagram selection (MIGHT BREAK GAUGE INVARIANCE!!!):"; nl ();
printf "!"; nl ();
printf "! %s" s; nl ();
printf "!"; nl ()
end;
begin match RCS.description M.rcs with
| line1 :: lines ->
printf "! in %s" line1; nl ();
List.iter (fun s -> printf "! %s" s; nl ()) lines
| [] -> printf "! in %s" (RCS.name M.rcs); nl ()
end;
printf "!"; nl ()
let print_version () =
printf "! O'Mega revision control information:"; nl ();
List.iter (fun s -> printf "! %s" s; nl ())
(ThoList.flatmap RCS.summary (M.rcs :: rcs_list @ F.rcs_list))
(* \thocwmodulesubsection{Printing Modules} *)
type accessibility =
| Public
| Private
| Protected (* Fortran 2003 *)
let accessibility_to_string = function
| Public -> "public"
| Private -> "private"
| Protected -> "protected"
type used_symbol =
| As_Is of string
| Aliased of string * string
let print_used_symbol = function
| As_Is name -> printf "%s" name
| Aliased (orig, alias) -> printf "%s => %s" alias orig
type used_module =
| Full of string
| Full_Aliased of string * (string * string) list
| Subset of string * used_symbol list
let print_used_module = function
| Full name
| Full_Aliased (name, [])
| Subset (name, []) ->
printf " use %s" name;
nl ()
| Full_Aliased (name, aliases) ->
printf " @[<5>use %s" name;
List.iter
(fun (orig, alias) -> printf ", %s => %s" alias orig)
aliases;
nl ()
| Subset (name, used_symbol :: used_symbols) ->
printf " @[<5>use %s, only: " name;
print_used_symbol used_symbol;
List.iter (fun s -> printf ", "; print_used_symbol s) used_symbols;
nl ()
type fortran_module =
{ module_name : string;
default_accessibility : accessibility;
used_modules : used_module list;
public_symbols : string list;
print_declarations : (unit -> unit) list;
print_implementations : (unit -> unit) list }
let print_public = function
| name1 :: names ->
printf " @[<2>public :: %s" name1;
List.iter (fun n -> printf ",@ %s" n) names; nl ()
| [] -> ()
let print_public_interface generic procedures =
printf " public :: %s" generic; nl ();
begin match procedures with
| name1 :: names ->
printf " interface %s" generic; nl ();
printf " @[<2>module procedure %s" name1;
List.iter (fun n -> printf ",@ %s" n) names; nl ();
printf " end interface"; nl ();
print_public procedures
| [] -> ()
end
let print_module m =
printf "module %s" m.module_name; nl ();
List.iter print_used_module m.used_modules;
printf " implicit none"; nl ();
printf " %s" (accessibility_to_string m.default_accessibility); nl ();
print_public m.public_symbols; nl ();
begin match m.print_declarations with
| [] -> ()
| print_declarations ->
List.iter (fun f -> f ()) print_declarations; nl ()
end;
begin match m.print_implementations with
| [] -> ()
| print_implementations ->
printf "contains"; nl (); nl ();
List.iter (fun f -> f ()) print_implementations; nl ();
end;
printf "end module %s" m.module_name; nl ()
let print_modules modules =
List.iter print_module modules;
print_version ();
print_flush ()
let module_to_file line_length oc prelude m =
output_string oc (m.module_name ^ "\n");
let filename = m.module_name ^ ".f90" in
let channel = open_out filename in
setup_fortran_formatter line_length channel;
prelude ();
print_modules [m];
close_out channel
let modules_to_file line_length oc prelude = function
| [] -> ()
| m :: mlist ->
module_to_file line_length oc prelude m;
List.iter (module_to_file line_length oc (fun () -> ())) mlist
(* \thocwmodulesubsection{Chopping Up Amplitudes} *)
let num_fusions_brakets size amplitudes =
let num_fusions =
max 1 size in
let count_brakets =
List.fold_left
(fun sum process -> sum + List.length (F.brakets process))
0 (CF.processes amplitudes)
and count_processes =
List.length (CF.processes amplitudes) in
if count_brakets > 0 then
let num_brakets =
max 1 ((num_fusions * count_processes) / count_brakets) in
(num_fusions, num_brakets)
else
(num_fusions, 1)
let chop_amplitudes size amplitudes =
let num_fusions, num_brakets = num_fusions_brakets size amplitudes in
(ThoList.enumerate 1 (ThoList.chopn num_fusions (CF.fusions amplitudes)),
ThoList.enumerate 1 (ThoList.chopn num_brakets (CF.processes amplitudes)))
let print_compute_fusions1 dictionary (n, fusions) =
if !openmp then begin
printf " subroutine compute_fusions_%04d (%s)" n openmp_tld; nl ();
printf " @[<5>type(%s), intent(inout) :: %s" openmp_tld_type openmp_tld; nl ();
end else begin
printf " @[<5>subroutine compute_fusions_%04d ()" n; nl ();
end;
print_fusions dictionary fusions;
printf " end subroutine compute_fusions_%04d" n; nl ()
and print_compute_brakets1 dictionary (n, processes) =
if !openmp then begin
printf " subroutine compute_brakets_%04d (%s)" n openmp_tld; nl ();
printf " @[<5>type(%s), intent(inout) :: %s" openmp_tld_type openmp_tld; nl ();
end else begin
printf " @[<5>subroutine compute_brakets_%04d ()" n; nl ();
end;
List.iter (print_brakets dictionary) processes;
printf " end subroutine compute_brakets_%04d" n; nl ()
(* \thocwmodulesubsection{Common Stuff} *)
let omega_public_symbols =
["number_particles_in"; "number_particles_out";
"number_color_indices";
"reset_helicity_selection"; "new_event";
"is_allowed"; "get_amplitude"; "color_sum"; "openmp_supported"] @
ThoList.flatmap
(fun n -> ["number_" ^ n; n])
["spin_states"; "flavor_states"; "color_flows"; "color_factors"]
let whizard_public_symbols md5sum =
["init"; "final"; "update_alpha_s"] @
(match md5sum with Some _ -> ["md5sum"] | None -> [])
let used_modules () =
[Full "kinds";
Full Fermions.use_module;
Full_Aliased ("omega_color", ["omega_color_factor", omega_color_factor_abbrev])] @
List.map
(fun m -> Full m)
(match !parameter_module with "" -> !use_modules | pm -> pm :: !use_modules)
let public_symbols () =
if !whizard then
omega_public_symbols @ (whizard_public_symbols !md5sum)
else
omega_public_symbols
let print_constants amplitudes =
printf " ! DON'T EVEN THINK of removing the following!"; nl ();
printf " ! If the compiler complains about undeclared"; nl ();
printf " ! or undefined variables, you are compiling"; nl ();
printf " ! against an incompatible omega95 module!"; nl ();
printf " @[<2>integer, dimension(%d), parameter, private :: "
(List.length require_library);
printf "require =@ (/ @[";
print_list require_library;
printf " /)"; nl(); nl ();
(* Using these parameters makes sense for documentation, but in
practice, there is no need to ever change them. *)
List.iter
(function name, value -> print_integer_parameter name (value amplitudes))
[ ("n_prt", num_particles);
("n_in", num_particles_in);
("n_out", num_particles_out);
("n_cflow", num_color_flows); (* Number of different color amplitudes. *)
("n_cindex", num_color_indices); (* Maximum rank of color tensors. *)
("n_flv", num_flavors); (* Number of different flavor amplitudes. *)
("n_hel", num_helicities) (* Number of different helicty amplitudes. *) ];
nl ();
(* Abbreviations. *)
printf " ! NB: you MUST NOT change the value of %s here!!!" nc_parameter; nl();
printf " ! It is defined here for convenience only and must be"; nl ();
printf " ! compatible with hardcoded values in the amplitude!"; nl ();
print_real_parameter nc_parameter (CM.nc ()); (* $N_C$ *)
List.iter
(function name, value -> print_logical_parameter name value)
[ ("F", false); ("T", true) ]; nl ();
print_spin_tables amplitudes;
print_flavor_tables amplitudes;
print_color_tables amplitudes;
print_amplitude_table amplitudes;
print_helicity_selection_table ()
let print_interface amplitudes =
print_md5sum_functions !md5sum;
print_maintenance_functions amplitudes;
List.iter print_numeric_inquiry_functions
[("number_particles_in", "n_in");
("number_particles_out", "n_out")];
List.iter print_inquiry_functions
["spin_states"; "flavor_states"];
print_inquiry_function_openmp ();
print_color_flows ();
print_color_factors ();
print_dispatch_functions ();
nl();
current_continuation_line := 0;
if !km_write || !km_pure then (Targets_Kmatrix.Fortran.print !km_pure);
current_continuation_line := 1;
nl()
let print_calculate_amplitudes declarations computations amplitudes =
printf " @[<5>subroutine calculate_amplitudes (amp, k, mask)"; nl ();
printf " complex(kind=%s), dimension(:,:,:), intent(out) :: amp" !kind; nl ();
printf " real(kind=%s), dimension(0:3,*), intent(in) :: k" !kind; nl ();
printf " logical, dimension(:), intent(in) :: mask"; nl ();
printf " integer, dimension(n_prt) :: s"; nl ();
printf " integer :: h, hi"; nl ();
declarations ();
begin match CF.processes amplitudes with
| p :: _ -> print_external_momenta p
| _ -> ()
end;
ignore (List.fold_left print_momenta PSet.empty (CF.processes amplitudes));
printf " amp = 0"; nl ();
if num_helicities amplitudes > 0 then begin
printf " if (hel_finite == 0) return"; nl ();
if !openmp then begin
printf "!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(s, h, %s) SCHEDULE(STATIC)" openmp_tld; nl();
end;
printf " do hi = 1, hel_finite"; nl ();
printf " h = hel_map(hi)"; nl ();
printf " s = table_spin_states(:,h)"; nl ();
ignore (List.fold_left print_externals WFSet.empty (CF.processes amplitudes));
computations ();
List.iter print_fudge_factor (CF.processes amplitudes);
(* This sorting should slightly improve cache locality. *)
let triple_snd = fun (_, x, _) -> x
in let triple_fst = fun (x, _, _) -> x
in let rec builder1 flvi flowi flows = match flows with
| (Some a) :: tl -> (flvi, flowi, flavors_symbol (flavors a)) :: (builder1 flvi (flowi + 1) tl)
| None :: tl -> builder1 flvi (flowi + 1) tl
| [] -> []
in let rec builder2 flvi flvs = match flvs with
| flv :: tl -> (builder1 flvi 1 flv) @ (builder2 (flvi + 1) tl)
| [] -> []
in let unsorted = builder2 1 (List.map Array.to_list (Array.to_list (CF.process_table amplitudes)))
in let sorted = List.sort (fun a b ->
if (triple_snd a != triple_snd b) then triple_snd a - triple_snd b else (triple_fst a - triple_fst b))
unsorted
in List.iter (fun (flvi, flowi, flv) ->
(printf " amp(%d,%d,h) = %s" flvi flowi flv; nl ();)) sorted;
(*i printf " else"; nl ();
printf " amp(:,h,:) = 0"; nl (); i*)
printf " end do"; nl ();
if !openmp then begin
printf "!$OMP END PARALLEL DO"; nl ();
end;
end;
printf " end subroutine calculate_amplitudes"; nl ()
let print_compute_chops chopped_fusions chopped_brakets () =
List.iter
(fun (i, _) -> printf " call compute_fusions_%04d (%s)" i
(if !openmp then openmp_tld else ""); nl ())
chopped_fusions;
List.iter
(fun (i, _) -> printf " call compute_brakets_%04d (%s)" i
(if !openmp then openmp_tld else ""); nl ())
chopped_brakets
(* \thocwmodulesubsection{Single Function} *)
let amplitudes_to_channel_single_function cmdline oc amplitudes =
let print_declarations () =
print_constants amplitudes
and print_implementations () =
print_interface amplitudes;
print_calculate_amplitudes
(fun () -> print_variable_declarations amplitudes)
(fun () ->
print_fusions (CF.dictionary amplitudes) (CF.fusions amplitudes);
List.iter
(print_brakets (CF.dictionary amplitudes))
(CF.processes amplitudes))
amplitudes in
let fortran_module =
{ module_name = !module_name;
used_modules = used_modules ();
default_accessibility = Private;
public_symbols = public_symbols ();
print_declarations = [print_declarations];
print_implementations = [print_implementations] } in
setup_fortran_formatter !line_length oc;
print_description cmdline amplitudes ();
print_modules [fortran_module]
(* \thocwmodulesubsection{Single Module} *)
let amplitudes_to_channel_single_module cmdline oc size amplitudes =
let print_declarations () =
print_constants amplitudes;
print_variable_declarations amplitudes
and print_implementations () =
print_interface amplitudes in
let chopped_fusions, chopped_brakets =
chop_amplitudes size amplitudes in
let dictionary = CF.dictionary amplitudes in
let print_compute_amplitudes () =
print_calculate_amplitudes
(fun () -> ())
(print_compute_chops chopped_fusions chopped_brakets)
amplitudes
and print_compute_fusions () =
List.iter (print_compute_fusions1 dictionary) chopped_fusions
and print_compute_brakets () =
List.iter (print_compute_brakets1 dictionary) chopped_brakets in
let fortran_module =
{ module_name = !module_name;
used_modules = used_modules ();
default_accessibility = Private;
public_symbols = public_symbols ();
print_declarations = [print_declarations];
print_implementations = [print_implementations;
print_compute_amplitudes;
print_compute_fusions;
print_compute_brakets] } in
setup_fortran_formatter !line_length oc;
print_description cmdline amplitudes ();
print_modules [fortran_module]
(* \thocwmodulesubsection{Multiple Modules} *)
let modules_of_amplitudes cmdline oc size amplitudes =
let name = !module_name in
let print_declarations () =
print_constants amplitudes
and print_variables () =
print_variable_declarations amplitudes in
let constants_module =
{ module_name = name ^ "_constants";
used_modules = used_modules ();
default_accessibility = Public;
public_symbols = [];
print_declarations = [print_declarations];
print_implementations = [] } in
let variables_module =
{ module_name = name ^ "_variables";
used_modules = used_modules ();
default_accessibility = Public;
public_symbols = [];
print_declarations = [print_variables];
print_implementations = [] } in
let dictionary = CF.dictionary amplitudes in
let print_compute_fusions (n, fusions) () =
if !openmp then begin
printf " subroutine compute_fusions_%04d (%s)" n openmp_tld; nl ();
printf " @[<5>type(%s), intent(inout) :: %s" openmp_tld_type openmp_tld; nl ();
end else begin
printf " @[<5>subroutine compute_fusions_%04d ()" n; nl ();
end;
print_fusions dictionary fusions;
printf " end subroutine compute_fusions_%04d" n; nl () in
let print_compute_brakets (n, processes) () =
if !openmp then begin
printf " subroutine compute_brakets_%04d (%s)" n openmp_tld; nl ();
printf " @[<5>type(%s), intent(inout) :: %s" openmp_tld_type openmp_tld; nl ();
end else begin
printf " @[<5>subroutine compute_brakets_%04d ()" n; nl ();
end;
List.iter (print_brakets dictionary) processes;
printf " end subroutine compute_brakets_%04d" n; nl () in
let fusions_module (n, _ as fusions) =
let tag = Printf.sprintf "_fusions_%04d" n in
{ module_name = name ^ tag;
used_modules = (used_modules () @
[Full constants_module.module_name;
Full variables_module.module_name]);
default_accessibility = Private;
public_symbols = ["compute" ^ tag];
print_declarations = [];
print_implementations = [print_compute_fusions fusions] } in
let brakets_module (n, _ as processes) =
let tag = Printf.sprintf "_brakets_%04d" n in
{ module_name = name ^ tag;
used_modules = (used_modules () @
[Full constants_module.module_name;
Full variables_module.module_name]);
default_accessibility = Private;
public_symbols = ["compute" ^ tag];
print_declarations = [];
print_implementations = [print_compute_brakets processes] } in
let chopped_fusions, chopped_brakets =
chop_amplitudes size amplitudes in
let fusions_modules =
List.map fusions_module chopped_fusions in
let brakets_modules =
List.map brakets_module chopped_brakets in
let print_implementations () =
print_interface amplitudes;
print_calculate_amplitudes
(fun () -> ())
(print_compute_chops chopped_fusions chopped_brakets)
amplitudes in
let public_module =
{ module_name = name;
used_modules = (used_modules () @
[Full constants_module.module_name;
Full variables_module.module_name ] @
List.map
(fun m -> Full m.module_name)
(fusions_modules @ brakets_modules));
default_accessibility = Private;
public_symbols = public_symbols ();
print_declarations = [];
print_implementations = [print_implementations] }
and private_modules =
[constants_module; variables_module] @ fusions_modules @ brakets_modules in
(public_module, private_modules)
let amplitudes_to_channel_single_file cmdline oc size amplitudes =
let public_module, private_modules =
modules_of_amplitudes cmdline oc size amplitudes in
setup_fortran_formatter !line_length oc;
print_description cmdline amplitudes ();
print_modules (private_modules @ [public_module])
let amplitudes_to_channel_multi_file cmdline oc size amplitudes =
let public_module, private_modules =
modules_of_amplitudes cmdline oc size amplitudes in
modules_to_file !line_length oc
(print_description cmdline amplitudes)
(public_module :: private_modules)
(* \thocwmodulesubsection{Dispatch} *)
let amplitudes_to_channel cmdline oc diagnostics amplitudes =
parse_diagnostics diagnostics;
match !output_mode with
| Single_Function ->
amplitudes_to_channel_single_function cmdline oc amplitudes
| Single_Module size ->
amplitudes_to_channel_single_module cmdline oc size amplitudes
| Single_File size ->
amplitudes_to_channel_single_file cmdline oc size amplitudes
| Multi_File size ->
amplitudes_to_channel_multi_file cmdline oc size amplitudes
let parameters_to_channel oc =
parameters_to_fortran oc (CM.parameters ())
end
module Fortran = Make_Fortran(Fortran_Fermions)
(* \thocwmodulesubsection{Majorana Fermions} *)
(* \begin{JR}
For this function we need a different approach due to our aim of
implementing the fermion vertices with the right line as ingoing (in a
calculational sense) and the left line in a fusion as outgoing. In
defining all external lines and the fermionic wavefunctions built out of
them as ingoing we have to invert the left lines to make them outgoing.
This happens by multiplying them with the inverse charge conjugation
matrix in an appropriate representation and then transposing it. We must
distinguish whether the direction of calculation and the physical direction
of the fermion number flow are parallel or antiparallel. In the first case
we can use the "normal" Feynman rules for Dirac particles, while in the
second, according to the paper of Denner et al., we have to reverse the
sign of the vector and antisymmetric bilinears of the Dirac spinors, cf.
the [Coupling] module.
Note the subtlety for the left- and righthanded couplings: Only the vector
part of these couplings changes in the appropriate cases its sign,
changing the chirality to the negative of the opposite.
\end{JR} *)
module Fortran_Majorana_Fermions : Fermions =
struct
let rcs = RCS.rename rcs_file "Targets.Fortran_Majorana_Fermions()"
[ "generates Fortran95 code for Dirac and Majorana fermions";
" using revision 2003_03_A of module omega95_bispinors" ]
open Coupling
open Format
let psi_type = "bispinor"
let psibar_type = "bispinor"
let chi_type = "bispinor"
let grav_type = "vectorspinor"
(* \begin{JR}
Because of our rules for fermions we are going to give all incoming fermions
a [u] spinor and all outgoing fermions a [v] spinor, no matter whether they
are Dirac fermions, antifermions or Majorana fermions.
\end{JR} *)
let psi_incoming = "u"
let brs_psi_incoming = "brs_u"
let psibar_incoming = "u"
let brs_psibar_incoming = "brs_u"
let chi_incoming = "u"
let brs_chi_incoming = "brs_u"
let grav_incoming = "ueps"
let psi_outgoing = "v"
let brs_psi_outgoing = "brs_v"
let psibar_outgoing = "v"
let brs_psibar_outgoing = "brs_v"
let chi_outgoing = "v"
let brs_chi_outgoing = "brs_v"
let grav_outgoing = "veps"
let psi_propagator = "pr_psi"
let psibar_propagator = "pr_psi"
let chi_propagator = "pr_psi"
let grav_propagator = "pr_grav"
let psi_projector = "pj_psi"
let psibar_projector = "pj_psi"
let chi_projector = "pj_psi"
let grav_projector = "pj_grav"
let psi_gauss = "pg_psi"
let psibar_gauss = "pg_psi"
let chi_gauss = "pg_psi"
let grav_gauss = "pg_grav"
let format_coupling coeff c =
match coeff with
| 1 -> c
| -1 -> "(-" ^ c ^")"
| coeff -> string_of_int coeff ^ "*" ^ c
let format_coupling_2 coeff c =
match coeff with
| 1 -> c
| -1 -> "-" ^ c
| coeff -> string_of_int coeff ^ "*" ^ c
(* \begin{dubious}
JR's coupling constant HACK, necessitated by tho's bad design descition.
\end{dubious} *)
let fastener s i =
try
let offset = (String.index s '(') in
if ((String.get s (String.length s - 1)) != ')') then
failwith "fastener: wrong usage of parentheses"
else
let func_name = (String.sub s 0 offset) and
tail =
(String.sub s (succ offset) (String.length s - offset - 2)) in
if (String.contains func_name ')') or
(String.contains tail '(') or
(String.contains tail ')') then
failwith "fastener: wrong usage of parentheses"
else
func_name ^ "(" ^ string_of_int i ^ "," ^ tail ^ ")"
with
| Not_found ->
if (String.contains s ')') then
failwith "fastener: wrong usage of parentheses"
else
s ^ "(" ^ string_of_int i ^ ")"
let print_fermion_current coeff f c wf1 wf2 fusion =
let c = format_coupling coeff c in
match fusion with
| F13 | F31 -> printf "%s_ff(%s,%s,%s)" f c wf1 wf2
| F23 | F21 -> printf "f_%sf(%s,%s,%s)" f c wf1 wf2
| F32 | F12 -> printf "f_%sf(%s,%s,%s)" f c wf2 wf1
let print_fermion_current2 coeff f c wf1 wf2 fusion =
let c = format_coupling_2 coeff c in
let c1 = fastener c 1 and
c2 = fastener c 2 in
match fusion with
| F13 | F31 -> printf "%s_ff(%s,%s,%s,%s)" f c1 c2 wf1 wf2
| F23 | F21 -> printf "f_%sf(%s,%s,%s,%s)" f c1 c2 wf1 wf2
| F32 | F12 -> printf "f_%sf(%s,%s,%s,%s)" f c1 c2 wf2 wf1
let print_fermion_current_vector coeff f c wf1 wf2 fusion =
let c = format_coupling coeff c in
match fusion with
| F13 -> printf "%s_ff(%s,%s,%s)" f c wf1 wf2
| F31 -> printf "%s_ff(-%s,%s,%s)" f c wf1 wf2
| F23 -> printf "f_%sf(%s,%s,%s)" f c wf1 wf2
| F32 -> printf "f_%sf(%s,%s,%s)" f c wf2 wf1
| F12 -> printf "f_%sf(-%s,%s,%s)" f c wf2 wf1
| F21 -> printf "f_%sf(-%s,%s,%s)" f c wf1 wf2
let print_fermion_current2_vector coeff f c wf1 wf2 fusion =
let c = format_coupling_2 coeff c in
let c1 = fastener c 1 and
c2 = fastener c 2 in
match fusion with
| F13 -> printf "%s_ff(%s,%s,%s,%s)" f c1 c2 wf1 wf2
| F31 -> printf "%s_ff(-(%s),%s,%s,%s)" f c1 c2 wf1 wf2
| F23 -> printf "f_%sf(%s,%s,%s,%s)" f c1 c2 wf1 wf2
| F32 -> printf "f_%sf(%s,%s,%s,%s)" f c1 c2 wf2 wf1
| F12 -> printf "f_%sf(-(%s),%s,%s,%s)" f c1 c2 wf2 wf1
| F21 -> printf "f_%sf(-(%s),%s,%s,%s)" f c1 c2 wf1 wf2
let print_fermion_current_chiral coeff f1 f2 c wf1 wf2 fusion =
let c = format_coupling coeff c in
match fusion with
| F13 -> printf "%s_ff(%s,%s,%s)" f1 c wf1 wf2
| F31 -> printf "%s_ff(-%s,%s,%s)" f2 c wf1 wf2
| F23 -> printf "f_%sf(%s,%s,%s)" f1 c wf1 wf2
| F32 -> printf "f_%sf(%s,%s,%s)" f1 c wf2 wf1
| F12 -> printf "f_%sf(-%s,%s,%s)" f2 c wf2 wf1
| F21 -> printf "f_%sf(-%s,%s,%s)" f2 c wf1 wf2
let print_fermion_current2_chiral coeff f c wf1 wf2 fusion =
let c = format_coupling_2 coeff c in
let c1 = fastener c 1 and
c2 = fastener c 2 in
match fusion with
| F13 -> printf "%s_ff(%s,%s,%s,%s)" f c1 c2 wf1 wf2
| F31 -> printf "%s_ff(-(%s),-(%s),%s,%s)" f c2 c1 wf1 wf2
| F23 -> printf "f_%sf(%s,%s,%s,%s)" f c1 c2 wf1 wf2
| F32 -> printf "f_%sf(%s,%s,%s,%s)" f c1 c2 wf2 wf1
| F12 -> printf "f_%sf(-(%s),-(%s),%s,%s)" f c2 c1 wf2 wf1
| F21 -> printf "f_%sf(-(%s),-(%s),%s,%s)" f c2 c1 wf1 wf2
let print_current = function
| coeff, _, VA, _ -> print_fermion_current2_vector coeff "va"
| coeff, _, V, _ -> print_fermion_current_vector coeff "v"
| coeff, _, A, _ -> print_fermion_current coeff "a"
| coeff, _, VL, _ -> print_fermion_current_chiral coeff "vl" "vr"
| coeff, _, VR, _ -> print_fermion_current_chiral coeff "vr" "vl"
| coeff, _, VLR, _ -> print_fermion_current2_chiral coeff "vlr"
| coeff, _, SP, _ -> print_fermion_current2 coeff "sp"
| coeff, _, S, _ -> print_fermion_current coeff "s"
| coeff, _, P, _ -> print_fermion_current coeff "p"
| coeff, _, SL, _ -> print_fermion_current coeff "sl"
| coeff, _, SR, _ -> print_fermion_current coeff "sr"
| coeff, _, SLR, _ -> print_fermion_current2 coeff "slr"
| coeff, _, POT, _ -> print_fermion_current_vector coeff "pot"
| coeff, _, _, _ -> invalid_arg
"Targets.Fortran_Majorana_Fermions: Not needed in the models"
let print_current_p = function
| coeff, Psi, SL, Psi -> print_fermion_current coeff "sl"
| coeff, Psi, SR, Psi -> print_fermion_current coeff "sr"
| coeff, Psi, SLR, Psi -> print_fermion_current2 coeff "slr"
| coeff, _, _, _ -> invalid_arg
"Targets.Fortran_Majorana_Fermions: Not needed in the used models"
let print_current_b = function
| coeff, Psibar, SL, Psibar -> print_fermion_current coeff "sl"
| coeff, Psibar, SR, Psibar -> print_fermion_current coeff "sr"
| coeff, Psibar, SLR, Psibar -> print_fermion_current2 coeff "slr"
| coeff, _, _, _ -> invalid_arg
"Targets.Fortran_Majorana_Fermions: Not needed in the used models"
(* This function is for the vertices with three particles including two
fermions but also a momentum, therefore with a dimensionful coupling
constant, e.g. the gravitino vertices. One has to dinstinguish between
the two kinds of canonical orders in the string of gamma matrices. Of
course, the direction of the string of gamma matrices is reversed if one
goes from the [Gravbar, _, Psi] to the [Psibar, _, Grav] vertices, and
the same is true for the couplings of the gravitino to the Majorana
fermions. For more details see the tables in the [coupling]
implementation. *)
(* We now have to fix the directions of the momenta. For making the compiler
happy and because we don't want to make constructions of infinite
complexity we list the momentum including vertices without gravitinos
here; the pattern matching says that's better. Perhaps we have to find a
better name now.
For the cases of $MOM$, $MOM5$, $MOML$ and $MOMR$ which arise only in
BRST transformations we take the mass as a coupling constant. For
$VMOM$ we don't need a mass either. These vertices are like kinetic terms
and so need not have a coupling constant. By this we avoid a strange and
awful construction with a new variable. But be careful with a
generalization if you want to use these vertices for other purposes.
*)
let format_coupling_mom coeff c =
match coeff with
| 1 -> c
| -1 -> "(-" ^ c ^")"
| coeff -> string_of_int coeff ^ "*" ^ c
let commute_proj f =
match f with
| "moml" -> "lmom"
| "momr" -> "rmom"
| "lmom" -> "moml"
| "rmom" -> "momr"
| "svl" -> "svr"
| "svr" -> "svl"
| "sl" -> "sr"
| "sr" -> "sl"
| "s" -> "s"
| "p" -> "p"
| _ -> invalid_arg "Targets:Fortran_Majorana_Fermions: wrong case"
let print_fermion_current_mom coeff f c wf1 wf2 p1 p2 p12 fusion =
let c = format_coupling_mom coeff c in
let c1 = fastener c 1 and
c2 = fastener c 2 in
match fusion with
| F13 -> printf "%s_ff(%s,%s,%s,%s,%s)" f c1 c2 wf1 wf2 p12
| F31 -> printf "%s_ff(%s,%s,%s,%s,%s)" f c1 c2 wf1 wf2 p12
| F23 -> printf "f_%sf(%s,%s,%s,%s,%s)" f c1 c2 wf1 wf2 p1
| F32 -> printf "f_%sf(%s,%s,%s,%s,%s)" f c1 c2 wf2 wf1 p2
| F12 -> printf "f_%sf(%s,%s,%s,%s,%s)" f c1 c2 wf2 wf1 p2
| F21 -> printf "f_%sf(%s,%s,%s,%s,%s)" f c1 c2 wf1 wf2 p1
let print_fermion_current_mom_vector coeff f c wf1 wf2 p1 p2 p12 fusion =
let c = format_coupling_mom coeff c in
let c1 = fastener c 1 and
c2 = fastener c 2 in
match fusion with
| F13 -> printf "%s_ff(%s,%s,%s,%s,%s)" f c1 c2 wf1 wf2 p12
| F31 -> printf "%s_ff(-%s,%s,%s,%s,%s)" f c1 c2 wf1 wf2 p12
| F23 -> printf "f_%sf(%s,%s,%s,%s,%s)" f c1 c2 wf1 wf2 p1
| F32 -> printf "f_%sf(%s,%s,%s,%s,%s)" f c1 c2 wf2 wf1 p2
| F12 -> printf "f_%sf(-%s,%s,%s,%s,%s)" f c1 c2 wf2 wf1 p2
| F21 -> printf "f_%sf(-%s,%s,%s,%s,%s)" f c1 c2 wf1 wf2 p1
let print_fermion_current_mom_sign coeff f c wf1 wf2 p1 p2 p12 fusion =
let c = format_coupling_mom coeff c in
let c1 = fastener c 1 and
c2 = fastener c 2 in
match fusion with
| F13 -> printf "%s_ff(%s,%s,%s,%s,%s)" f c1 c2 wf1 wf2 p12
| F31 -> printf "%s_ff(%s,%s,%s,%s,-(%s))" f c1 c2 wf1 wf2 p12
| F23 -> printf "f_%sf(%s,%s,%s,%s,%s)" f c1 c2 wf1 wf2 p1
| F32 -> printf "f_%sf(%s,%s,%s,%s,%s)" f c1 c2 wf2 wf1 p2
| F12 -> printf "f_%sf(%s,%s,%s,%s,-(%s))" f c1 c2 wf2 wf1 p2
| F21 -> printf "f_%sf(%s,%s,%s,%s,-(%s))" f c1 c2 wf1 wf2 p1
let print_fermion_current_mom_sign_1 coeff f c wf1 wf2 p1 p2 p12 fusion =
let c = format_coupling coeff c in
match fusion with
| F13 -> printf "%s_ff(%s,%s,%s,%s)" f c wf1 wf2 p12
| F31 -> printf "%s_ff(%s,%s,%s,-(%s))" f c wf1 wf2 p12
| F23 -> printf "f_%sf(%s,%s,%s,%s)" f c wf1 wf2 p1
| F32 -> printf "f_%sf(%s,%s,%s,%s)" f c wf2 wf1 p2
| F12 -> printf "f_%sf(%s,%s,%s,-(%s))" f c wf2 wf1 p2
| F21 -> printf "f_%sf(%s,%s,%s,-(%s))" f c wf1 wf2 p1
let print_fermion_current_mom_chiral coeff f c wf1 wf2 p1 p2 p12 fusion =
let c = format_coupling_mom coeff c and
cf = commute_proj f in
let c1 = fastener c 1 and
c2 = fastener c 2 in
match fusion with
| F13 -> printf "%s_ff(%s,%s,%s,%s,%s)" f c1 c2 wf1 wf2 p12
| F31 -> printf "%s_ff(%s,%s,%s, %s,-(%s))" cf c1 c2 wf1 wf2 p12
| F23 -> printf "f_%sf(%s,%s,%s,%s,%s)" f c1 c2 wf1 wf2 p1
| F32 -> printf "f_%sf(%s,%s,%s,%s,%s)" f c1 c2 wf2 wf1 p2
| F12 -> printf "f_%sf(%s,%s,%s,%s,-(%s))" cf c1 c2 wf2 wf1 p2
| F21 -> printf "f_%sf(%s,%s,%s,%s,-(%s))" cf c1 c2 wf1 wf2 p1
let print_fermion_g_current coeff f c wf1 wf2 p1 p2 p12 fusion =
let c = format_coupling coeff c in
match fusion with
| F13 -> printf "%s_grf(%s,%s,%s,%s)" f c wf1 wf2 p12
| F31 -> printf "%s_fgr(%s,%s,%s,%s)" f c wf1 wf2 p12
| F23 -> printf "gr_%sf(%s,%s,%s,%s)" f c wf1 wf2 p1
| F32 -> printf "gr_%sf(%s,%s,%s,%s)" f c wf2 wf1 p2
| F12 -> printf "f_%sgr(%s,%s,%s,%s)" f c wf2 wf1 p2
| F21 -> printf "f_%sgr(%s,%s,%s,%s)" f c wf1 wf2 p1
let print_fermion_g_2_current coeff f c wf1 wf2 p1 p2 p12 fusion =
let c = format_coupling coeff c in
match fusion with
| F13 -> printf "%s_grf(%s(1),%s(2),%s,%s,%s)" f c c wf1 wf2 p12
| F31 -> printf "%s_fgr(%s(1),%s(2),%s,%s,%s)" f c c wf1 wf2 p12
| F23 -> printf "gr_%sf(%s(1),%s(2),%s,%s,%s)" f c c wf1 wf2 p1
| F32 -> printf "gr_%sf(%s(1),%s(2),%s,%s,%s)" f c c wf2 wf1 p2
| F12 -> printf "f_%sgr(%s(1),%s(2),%s,%s,%s)" f c c wf2 wf1 p2
| F21 -> printf "f_%sgr(%s(1),%s(2),%s,%s,%s)" f c c wf1 wf2 p1
let print_fermion_g_current_rev coeff f c wf1 wf2 p1 p2 p12 fusion =
let c = format_coupling coeff c in
match fusion with
| F13 -> printf "%s_fgr(%s,%s,%s,%s)" f c wf1 wf2 p12
| F31 -> printf "%s_grf(%s,%s,%s,%s)" f c wf1 wf2 p12
| F23 -> printf "f_%sgr(%s,%s,%s,%s)" f c wf1 wf2 p1
| F32 -> printf "f_%sgr(%s,%s,%s,%s)" f c wf2 wf1 p2
| F12 -> printf "gr_%sf(%s,%s,%s,%s)" f c wf2 wf1 p2
| F21 -> printf "gr_%sf(%s,%s,%s,%s)" f c wf1 wf2 p1
let print_fermion_g_2_current_rev coeff f c wf1 wf2 p1 p2 p12 fusion =
let c = format_coupling coeff c in
match fusion with
| F13 -> printf "%s_fgr(%s(1),%s(2),%s,%s,%s)" f c c wf1 wf2 p12
| F31 -> printf "%s_grf(%s(1),%s(2),%s,%s,%s)" f c c wf1 wf2 p12
| F23 -> printf "f_%sgr(%s(1),%s(2),%s,%s,%s)" f c c wf1 wf2 p1
| F32 -> printf "f_%sgr(%s(1),%s(2),%s,%s,%s)" f c c wf2 wf1 p2
| F12 -> printf "gr_%sf(%s(1),%s(2),%s,%s,%s)" f c c wf2 wf1 p2
| F21 -> printf "gr_%sf(%s(1),%s(2),%s,%s,%s)" f c c wf1 wf2 p1
let print_fermion_g_current_vector coeff f c wf1 wf2 p1 p2 p12 fusion =
let c = format_coupling coeff c in
match fusion with
| F13 -> printf "%s_grf(%s,%s,%s)" f c wf1 wf2
| F31 -> printf "%s_fgr(-%s,%s,%s)" f c wf1 wf2
| F23 -> printf "gr_%sf(%s,%s,%s)" f c wf1 wf2
| F32 -> printf "gr_%sf(%s,%s,%s)" f c wf2 wf1
| F12 -> printf "f_%sgr(-%s,%s,%s)" f c wf2 wf1
| F21 -> printf "f_%sgr(-%s,%s,%s)" f c wf1 wf2
let print_fermion_g_current_vector_rev coeff f c wf1 wf2 p1 p2 p12 fusion =
let c = format_coupling coeff c in
match fusion with
| F13 -> printf "%s_fgr(%s,%s,%s)" f c wf1 wf2
| F31 -> printf "%s_grf(-%s,%s,%s)" f c wf1 wf2
| F23 -> printf "f_%sgr(%s,%s,%s)" f c wf1 wf2
| F32 -> printf "f_%sgr(%s,%s,%s)" f c wf2 wf1
| F12 -> printf "gr_%sf(-%s,%s,%s)" f c wf2 wf1
| F21 -> printf "gr_%sf(-%s,%s,%s)" f c wf1 wf2
let print_current_g = function
| coeff, _, MOM, _ -> print_fermion_current_mom_sign coeff "mom"
| coeff, _, MOM5, _ -> print_fermion_current_mom coeff "mom5"
| coeff, _, MOML, _ -> print_fermion_current_mom_chiral coeff "moml"
| coeff, _, MOMR, _ -> print_fermion_current_mom_chiral coeff "momr"
| coeff, _, LMOM, _ -> print_fermion_current_mom_chiral coeff "lmom"
| coeff, _, RMOM, _ -> print_fermion_current_mom_chiral coeff "rmom"
| coeff, _, VMOM, _ -> print_fermion_current_mom_sign_1 coeff "vmom"
| coeff, Gravbar, S, _ -> print_fermion_g_current coeff "s"
| coeff, Gravbar, SL, _ -> print_fermion_g_current coeff "sl"
| coeff, Gravbar, SR, _ -> print_fermion_g_current coeff "sr"
| coeff, Gravbar, SLR, _ -> print_fermion_g_2_current coeff "slr"
| coeff, Gravbar, P, _ -> print_fermion_g_current coeff "p"
| coeff, Gravbar, V, _ -> print_fermion_g_current coeff "v"
| coeff, Gravbar, VLR, _ -> print_fermion_g_2_current coeff "vlr"
| coeff, Gravbar, POT, _ -> print_fermion_g_current_vector coeff "pot"
| coeff, _, S, Grav -> print_fermion_g_current_rev coeff "s"
| coeff, _, SL, Grav -> print_fermion_g_current_rev coeff "sl"
| coeff, _, SR, Grav -> print_fermion_g_current_rev coeff "sr"
| coeff, _, SLR, Grav -> print_fermion_g_2_current_rev coeff "slr"
| coeff, _, P, Grav -> print_fermion_g_current_rev (-coeff) "p"
| coeff, _, V, Grav -> print_fermion_g_current_rev coeff "v"
| coeff, _, VLR, Grav -> print_fermion_g_2_current_rev coeff "vlr"
| coeff, _, POT, Grav -> print_fermion_g_current_vector_rev coeff "pot"
| coeff, _, _, _ -> invalid_arg
"Targets.Fortran_Majorana_Fermions: not used in the models"
let print_current_mom = function
| coeff, _, _, _ -> invalid_arg
"Targets.Fortran_Majorana_Fermions: Not needed in the models"
(* We need support for dimension-5 vertices with two fermions and two
bosons, appearing in theories of supergravity and also together with in
insertions of the supersymmetric current. There is a canonical order
[fermionbar], [boson_1], [boson_2], [fermion], so what one has to do is a
mapping from the fusions [F123] etc. to the order of the three wave
functions [wf1], [wf2] and [wf3]. *)
(* The function [d_p] (for distinct the particle) distinguishes which particle
(scalar or vector) must be fused to in the special functions. *)
let d_p = function
| 1, ("sv"|"pv"|"svl"|"svr"|"slrv") -> "1"
| 1, _ -> ""
| 2, ("sv"|"pv"|"svl"|"svr"|"slrv") -> "2"
| 2, _ -> ""
| _, _ -> invalid_arg "Targets.Fortran_Majorana_Fermions: not used"
let wf_of_f wf1 wf2 wf3 f =
match f with
| (F123|F423) -> [wf2; wf3; wf1]
| (F213|F243|F143|F142|F413|F412) -> [wf1; wf3; wf2]
| (F132|F432) -> [wf3; wf2; wf1]
| (F231|F234|F134|F124|F431|F421) -> [wf1; wf2; wf3]
| (F312|F342) -> [wf3; wf1; wf2]
| (F321|F324|F314|F214|F341|F241) -> [wf2; wf1; wf3]
let print_fermion_g4_brs_vector_current coeff f c wf1 wf2 wf3 fusion =
let cf = commute_proj f and
cp = format_coupling coeff c and
cm = if f = "pv" then
format_coupling coeff c
else
format_coupling (-coeff) c
and
d1 = d_p (1,f) and
d2 = d_p (2,f) and
f1 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 0) and
f2 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 1) and
f3 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 2) in
match fusion with
| (F123|F213|F132|F231|F312|F321) ->
printf "f_%sf(%s,%s,%s,%s)" cf cm f1 f2 f3
| (F423|F243|F432|F234|F342|F324) ->
printf "f_%sf(%s,%s,%s,%s)" f cp f1 f2 f3
| (F134|F143|F314) -> printf "%s%s_ff(%s,%s,%s,%s)" f d1 cp f1 f2 f3
| (F124|F142|F214) -> printf "%s%s_ff(%s,%s,%s,%s)" f d2 cp f1 f2 f3
| (F413|F431|F341) -> printf "%s%s_ff(%s,%s,%s,%s)" cf d1 cm f1 f2 f3
| (F241|F412|F421) -> printf "%s%s_ff(%s,%s,%s,%s)" cf d2 cm f1 f2 f3
let print_fermion_g4_svlr_current coeff f c wf1 wf2 wf3 fusion =
let c = format_coupling_2 coeff c and
f1 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 0) and
f2 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 1) and
f3 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 2) in
let c1 = fastener c 1 and
c2 = fastener c 2 in
match fusion with
| (F123|F213|F132|F231|F312|F321) ->
printf "f_svlrf(-(%s),-(%s),%s,%s,%s)" c2 c1 f1 f2 f3
| (F423|F243|F432|F234|F342|F324) ->
printf "f_svlrf(%s,%s,%s,%s,%s)" c1 c2 f1 f2 f3
| (F134|F143|F314) ->
printf "svlr2_ff(%s,%s,%s,%s,%s)" c1 c2 f1 f2 f3
| (F124|F142|F214) ->
printf "svlr1_ff(%s,%s,%s,%s,%s)" c1 c2 f1 f2 f3
| (F413|F431|F341) ->
printf "svlr2_ff(-(%s),-(%s),%s,%s,%s)" c2 c1 f1 f2 f3
| (F241|F412|F421) ->
printf "svlr1_ff(-(%s),-(%s),%s,%s,%s)" c2 c1 f1 f2 f3
let print_fermion_s2_current coeff f c wf1 wf2 wf3 fusion =
let cp = format_coupling coeff c and
cm = if f = "p" then
format_coupling (-coeff) c
else
format_coupling coeff c
and
cf = commute_proj f and
f1 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 0) and
f2 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 1) and
f3 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 2) in
match fusion with
| (F123|F213|F132|F231|F312|F321) ->
printf "%s * f_%sf(%s,%s,%s)" f1 cf cm f2 f3
| (F423|F243|F432|F234|F342|F324) ->
printf "%s * f_%sf(%s,%s,%s)" f1 f cp f2 f3
| (F134|F143|F314) ->
printf "%s * %s_ff(%s,%s,%s)" f2 f cp f1 f3
| (F124|F142|F214) ->
printf "%s * %s_ff(%s,%s,%s)" f2 f cp f1 f3
| (F413|F431|F341) ->
printf "%s * %s_ff(%s,%s,%s)" f2 cf cm f1 f3
| (F241|F412|F421) ->
printf "%s * %s_ff(%s,%s,%s)" f2 cf cm f1 f3
let print_fermion_s2p_current coeff f c wf1 wf2 wf3 fusion =
let c = format_coupling_2 coeff c and
f1 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 0) and
f2 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 1) and
f3 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 2) in
let c1 = fastener c 1 and
c2 = fastener c 2 in
match fusion with
| (F123|F213|F132|F231|F312|F321) ->
printf "%s * f_%sf(%s,-(%s),%s,%s)" f1 f c1 c2 f2 f3
| (F423|F243|F432|F234|F342|F324) ->
printf "%s * f_%sf(%s,%s,%s,%s)" f1 f c1 c2 f2 f3
| (F134|F143|F314) ->
printf "%s * %s_ff(%s,%s,%s,%s)" f2 f c1 c2 f1 f3
| (F124|F142|F214) ->
printf "%s * %s_ff(%s,%s,%s,%s)" f2 f c1 c2 f1 f3
| (F413|F431|F341) ->
printf "%s * %s_ff(%s,-(%s),%s,%s)" f2 f c1 c2 f1 f3
| (F241|F412|F421) ->
printf "%s * %s_ff(%s,-(%s),%s,%s)" f2 f c1 c2 f1 f3
let print_fermion_s2lr_current coeff f c wf1 wf2 wf3 fusion =
let c = format_coupling_2 coeff c and
f1 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 0) and
f2 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 1) and
f3 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 2) in
let c1 = fastener c 1 and
c2 = fastener c 2 in
match fusion with
| (F123|F213|F132|F231|F312|F321) ->
printf "%s * f_%sf(%s,%s,%s,%s)" f1 f c2 c1 f2 f3
| (F423|F243|F432|F234|F342|F324) ->
printf "%s * f_%sf(%s,%s,%s,%s)" f1 f c1 c2 f2 f3
| (F134|F143|F314) ->
printf "%s * %s_ff(%s,%s,%s,%s)" f2 f c1 c2 f1 f3
| (F124|F142|F214) ->
printf "%s * %s_ff(%s,%s,%s,%s)" f2 f c1 c2 f1 f3
| (F413|F431|F341) ->
printf "%s * %s_ff(%s,%s,%s,%s)" f2 f c2 c1 f1 f3
| (F241|F412|F421) ->
printf "%s * %s_ff(%s,%s,%s,%s)" f2 f c2 c1 f1 f3
let print_fermion_g4_current coeff f c wf1 wf2 wf3 fusion =
let c = format_coupling coeff c and
f1 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 0) and
f2 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 1) and
f3 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 2) in
match fusion with
| (F123|F213|F132|F231|F312|F321) ->
printf "f_%sgr(-%s,%s,%s,%s)" f c f1 f2 f3
| (F423|F243|F432|F234|F342|F324) ->
printf "gr_%sf(%s,%s,%s,%s)" f c f1 f2 f3
| (F134|F143|F314|F124|F142|F214) ->
printf "%s_grf(%s,%s,%s,%s)" f c f1 f2 f3
| (F413|F431|F341|F241|F412|F421) ->
printf "%s_fgr(-%s,%s,%s,%s)" f c f1 f2 f3
let print_fermion_2_g4_current coeff f c wf1 wf2 wf3 fusion =
let f1 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 0) and
f2 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 1) and
f3 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 2) in
let c = format_coupling_2 coeff c in
let c1 = fastener c 1 and
c2 = fastener c 2 in
match fusion with
| (F123|F213|F132|F231|F312|F321) ->
printf "f_%sgr(-(%s),-(%s),%s,%s,%s)" f c2 c1 f1 f2 f3
| (F423|F243|F432|F234|F342|F324) ->
printf "gr_%sf(%s,%s,%s,%s,%s)" f c1 c2 f1 f2 f3
| (F134|F143|F314|F124|F142|F214) ->
printf "%s_grf(%s,%s,%s,%s,%s)" f c1 c2 f1 f2 f3
| (F413|F431|F341|F241|F412|F421) ->
printf "%s_fgr(-(%s),-(%s),%s,%s,%s)" f c2 c1 f1 f2 f3
let print_fermion_2_g4_current coeff f c wf1 wf2 wf3 fusion =
let f1 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 0) and
f2 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 1) and
f3 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 2) in
let c = format_coupling_2 coeff c in
let c1 = fastener c 1 and
c2 = fastener c 2 in
match fusion with
| (F123|F213|F132|F231|F312|F321) ->
printf "f_%sgr(-(%s),-(%s),%s,%s,%s)" f c2 c1 f1 f2 f3
| (F423|F243|F432|F234|F342|F324) ->
printf "gr_%sf(%s,%s,%s,%s,%s)" f c1 c2 f1 f2 f3
| (F134|F143|F314|F124|F142|F214) ->
printf "%s_grf(%s,%s,%s,%s,%s)" f c1 c2 f1 f2 f3
| (F413|F431|F341|F241|F412|F421) ->
printf "%s_fgr(-(%s),-(%s),%s,%s,%s)" f c2 c1 f1 f2 f3
let print_fermion_g4_current_rev coeff f c wf1 wf2 wf3 fusion =
let c = format_coupling coeff c and
f1 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 0) and
f2 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 1) and
f3 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 2) in
match fusion with
| (F123|F213|F132|F231|F312|F321) ->
printf "f_%sgr(%s,%s,%s,%s)" f c f1 f2 f3
| (F423|F243|F432|F234|F342|F324) ->
printf "gr_%sf(-%s,%s,%s,%s)" f c f1 f2 f3
| (F134|F143|F314|F124|F142|F214) ->
printf "%s_grf(-%s,%s,%s,%s)" f c f1 f2 f3
| (F413|F431|F341|F241|F412|F421) ->
printf "%s_fgr(%s,%s,%s,%s)" f c f1 f2 f3
(* Here we have to distinguish which of the two bosons is produced in the
fusion of three particles which include both fermions. *)
let print_fermion_g4_vector_current coeff f c wf1 wf2 wf3 fusion =
let c = format_coupling coeff c and
d1 = d_p (1,f) and
d2 = d_p (2,f) and
f1 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 0) and
f2 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 1) and
f3 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 2) in
match fusion with
| (F123|F213|F132|F231|F312|F321) ->
printf "f_%sgr(%s,%s,%s,%s)" f c f1 f2 f3
| (F423|F243|F432|F234|F342|F324) ->
printf "gr_%sf(%s,%s,%s,%s)" f c f1 f2 f3
| (F134|F143|F314) -> printf "%s%s_grf(%s,%s,%s,%s)" f d1 c f1 f2 f3
| (F124|F142|F214) -> printf "%s%s_grf(%s,%s,%s,%s)" f d2 c f1 f2 f3
| (F413|F431|F341) -> printf "%s%s_fgr(%s,%s,%s,%s)" f d1 c f1 f2 f3
| (F241|F412|F421) -> printf "%s%s_fgr(%s,%s,%s,%s)" f d2 c f1 f2 f3
let print_fermion_2_g4_vector_current coeff f c wf1 wf2 wf3 fusion =
let d1 = d_p (1,f) and
d2 = d_p (2,f) and
f1 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 0) and
f2 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 1) and
f3 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 2) in
let c = format_coupling_2 coeff c in
let c1 = fastener c 1 and
c2 = fastener c 2 in
match fusion with
| (F123|F213|F132|F231|F312|F321) ->
printf "f_%sgr(%s,%s,%s,%s,%s)" f c1 c2 f1 f2 f3
| (F423|F243|F432|F234|F342|F324) ->
printf "gr_%sf(%s,%s,%s,%s,%s)" f c1 c2 f1 f2 f3
| (F134|F143|F314) -> printf "%s%s_grf(%s,%s,%s,%s,%s)" f d1 c1 c2 f1 f2 f3
| (F124|F142|F214) -> printf "%s%s_grf(%s,%s,%s,%s,%s)" f d2 c1 c2 f1 f2 f3
| (F413|F431|F341) -> printf "%s%s_fgr(%s,%s,%s,%s,%s)" f d1 c1 c2 f1 f2 f3
| (F241|F412|F421) -> printf "%s%s_fgr(%s,%s,%s,%s,%s)" f d2 c1 c2 f1 f2 f3
let print_fermion_g4_vector_current_rev coeff f c wf1 wf2 wf3 fusion =
let c = format_coupling coeff c and
d1 = d_p (1,f) and
d2 = d_p (2,f) and
f1 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 0) and
f2 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 1) and
f3 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 2) in
match fusion with
| (F123|F213|F132|F231|F312|F321) ->
printf "gr_%sf(%s,%s,%s,%s)" f c f1 f2 f3
| (F423|F243|F432|F234|F342|F324) ->
printf "f_%sgr(%s,%s,%s,%s)" f c f1 f2 f3
| (F134|F143|F314) -> printf "%s%s_fgr(%s,%s,%s,%s)" f d1 c f1 f2 f3
| (F124|F142|F214) -> printf "%s%s_fgr(%s,%s,%s,%s)" f d2 c f1 f2 f3
| (F413|F431|F341) -> printf "%s%s_grf(%s,%s,%s,%s)" f d1 c f1 f2 f3
| (F241|F412|F421) -> printf "%s%s_grf(%s,%s,%s,%s)" f d2 c f1 f2 f3
let print_fermion_2_g4_current_rev coeff f c wf1 wf2 wf3 fusion =
let c = format_coupling_2 coeff c in
let c1 = fastener c 1 and
c2 = fastener c 2 and
d1 = d_p (1,f) and
d2 = d_p (2,f) in
let f1 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 0) and
f2 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 1) and
f3 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 2) in
match fusion with
| (F123|F213|F132|F231|F312|F321) ->
printf "gr_%sf(%s,%s,%s,%s,%s)" f c1 c2 f1 f2 f3
| (F423|F243|F432|F234|F342|F324) ->
printf "f_%sgr(-(%s),-(%s),%s,%s,%s)" f c1 c2 f1 f2 f3
| (F134|F143|F314) ->
printf "%s%s_fgr(-(%s),-(%s),%s,%s,%s)" f d1 c1 c2 f1 f2 f3
| (F124|F142|F214) ->
printf "%s%s_fgr(-(%s),-(%s),%s,%s,%s)" f d2 c1 c2 f1 f2 f3
| (F413|F431|F341) ->
printf "%s%s_grf(%s,%s,%s,%s,%s)" f d1 c1 c2 f1 f2 f3
| (F241|F412|F421) ->
printf "%s%s_grf(%s,%s,%s,%s,%s)" f d2 c1 c2 f1 f2 f3
let print_fermion_2_g4_vector_current_rev coeff f c wf1 wf2 wf3 fusion =
(* Here we put in the extra minus sign from the coeff. *)
let c = format_coupling coeff c in
let c1 = fastener c 1 and
c2 = fastener c 2 in
let d1 = d_p (1,f) and
d2 = d_p (2,f) and
f1 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 0) and
f2 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 1) and
f3 = (List.nth (wf_of_f wf1 wf2 wf3 fusion) 2) in
match fusion with
| (F123|F213|F132|F231|F312|F321) ->
printf "gr_%sf(%s,%s,%s,%s,%s)" f c1 c2 f1 f2 f3
| (F423|F243|F432|F234|F342|F324) ->
printf "f_%sgr(%s,%s,%s,%s,%s)" f c1 c2 f1 f2 f3
| (F134|F143|F314) -> printf "%s%s_fgr(%s,%s,%s,%s,%s)" f d1 c1 c2 f1 f2 f3
| (F124|F142|F214) -> printf "%s%s_fgr(%s,%s,%s,%s,%s)" f d2 c1 c2 f1 f2 f3
| (F413|F431|F341) -> printf "%s%s_grf(%s,%s,%s,%s,%s)" f d1 c1 c2 f1 f2 f3
| (F241|F412|F421) -> printf "%s%s_grf(%s,%s,%s,%s,%s)" f d2 c1 c2 f1 f2 f3
let print_current_g4 = function
| coeff, Gravbar, S2, _ -> print_fermion_g4_current coeff "s2"
| coeff, Gravbar, SV, _ -> print_fermion_g4_vector_current coeff "sv"
| coeff, Gravbar, SLV, _ -> print_fermion_g4_vector_current coeff "slv"
| coeff, Gravbar, SRV, _ -> print_fermion_g4_vector_current coeff "srv"
| coeff, Gravbar, SLRV, _ -> print_fermion_2_g4_vector_current coeff "slrv"
| coeff, Gravbar, PV, _ -> print_fermion_g4_vector_current coeff "pv"
| coeff, Gravbar, V2, _ -> print_fermion_g4_current coeff "v2"
| coeff, Gravbar, V2LR, _ -> print_fermion_2_g4_current coeff "v2lr"
| coeff, Gravbar, _, _ -> invalid_arg "print_current_g4: not implemented"
| coeff, _, S2, Grav -> print_fermion_g4_current_rev coeff "s2"
| coeff, _, SV, Grav -> print_fermion_g4_vector_current_rev (-coeff) "sv"
| coeff, _, SLV, Grav -> print_fermion_g4_vector_current_rev (-coeff) "slv"
| coeff, _, SRV, Grav -> print_fermion_g4_vector_current_rev (-coeff) "srv"
| coeff, _, SLRV, Grav -> print_fermion_2_g4_vector_current_rev coeff "slrv"
| coeff, _, PV, Grav -> print_fermion_g4_vector_current_rev coeff "pv"
| coeff, _, V2, Grav -> print_fermion_g4_vector_current_rev coeff "v2"
| coeff, _, V2LR, Grav -> print_fermion_2_g4_current_rev coeff "v2lr"
| coeff, _, _, Grav -> invalid_arg "print_current_g4: not implemented"
| coeff, _, S2, _ -> print_fermion_s2_current coeff "s"
| coeff, _, P2, _ -> print_fermion_s2_current coeff "p"
| coeff, _, S2P, _ -> print_fermion_s2p_current coeff "sp"
| coeff, _, S2L, _ -> print_fermion_s2_current coeff "sl"
| coeff, _, S2R, _ -> print_fermion_s2_current coeff "sr"
| coeff, _, S2LR, _ -> print_fermion_s2lr_current coeff "slr"
| coeff, _, V2, _ -> print_fermion_g4_brs_vector_current coeff "v2"
| coeff, _, SV, _ -> print_fermion_g4_brs_vector_current coeff "sv"
| coeff, _, PV, _ -> print_fermion_g4_brs_vector_current coeff "pv"
| coeff, _, SLV, _ -> print_fermion_g4_brs_vector_current coeff "svl"
| coeff, _, SRV, _ -> print_fermion_g4_brs_vector_current coeff "svr"
| coeff, _, SLRV, _ -> print_fermion_g4_svlr_current coeff "svlr"
| coeff, _, V2LR, _ -> invalid_arg "Targets.print_current: not available"
let reverse_braket _ = false
let use_module = "omega95_bispinors"
let require_library =
["omega_bispinors_2010_01_A"; "omega_bispinor_cpls_2010_01_A"]
end
module Fortran_Majorana = Make_Fortran(Fortran_Majorana_Fermions)
(* \thocwmodulesubsection{\texttt{FORTRAN\,77}} *)
module Fortran77 = Dummy
(* \thocwmodulesection{O'Mega Virtual Machine} *)
module VM = Dummy
(* \thocwmodulesection{\texttt{C}} *)
module C = Dummy
(* \thocwmodulesubsection{\texttt{C++}} *)
module Cpp = Dummy
(* \thocwmodulesubsection{Java} *)
module Java = Dummy
(* \thocwmodulesection{O'Caml} *)
module Ocaml = Dummy
(* \thocwmodulesection{\LaTeX} *)
module LaTeX = Dummy
(*i
module VM_old (F : Fusion.T) (Make_MF : Fusion.MultiMaker)
(M : Model.T with type flavor = F.flavor and type constant = F.constant) =
struct
let rcs_list =
[ RCS.rename rcs_file "Targets.VM()"
[ "Bytecode for the O'Mega Virtual Machine" ] ]
module MF = Make_MF(F)
type amplitude = F.amplitude
type amplitudes = MF.amplitudes
type diagnostic = All | Arguments | Momenta | Gauge
let options = Options.empty
let flavors_to_string flavors =
String.concat " " (List.map M.flavor_to_string flavors)
let format_process amplitude =
flavors_to_string (F.incoming amplitude) ^ " -> " ^
flavors_to_string (F.outgoing amplitude)
open Format
open Coupling
let ovm_LOAD_SCALAR = 1
let ovm_LOAD_U = 2
let ovm_LOAD_UBAR = 3
let ovm_LOAD_V = 4
let ovm_LOAD_VBAR = 5
let ovm_LOAD_VECTOR = 6
let ovm_ADD_MOMENTA = 10
let ovm_PROPAGATE_SCALAR = 11
let ovm_PROPAGATE_SPINOR = 12
let ovm_PROPAGATE_CONJSPINOR = 13
let ovm_PROPAGATE_UNITARITY = 14
let ovm_PROPAGATE_FEYNMAN = 15
let ovm_PROPAGATE_TENSOR2 = 16
let ovm_FUSE_VECTOR_PSIBAR_PSI = 21
let ovm_FUSE_PSI_VECTOR_PSI = 22
let ovm_FUSE_PSIBAR_PSIBAR_VECTOR = 23
type instruction =
{ code : int; sign : int; coupl : int;
lhs : int; rhs1 : int; rhs2 : int }
let printi i =
printf "@\n%3d %3d %3d %3d %3d %3d"
i.code i.sign i.coupl i.lhs i.rhs1 i.rhs2
let load lhs f rhs =
let code =
match M.lorentz f with
| Scalar -> ovm_LOAD_SCALAR
| Spinor -> ovm_LOAD_U
| ConjSpinor -> ovm_LOAD_UBAR
| Majorana -> failwith "load: Majoranas not implemented yet"
| Maj_Ghost -> failwith "load: SUSY ghosts not implemented yet"
| Vector | Massive_Vector -> ovm_LOAD_VECTOR
| Vectorspinor -> invalid_arg "external spin must be <=1"
| Tensor_1 -> invalid_arg "Tensor_1 only internal"
| Tensor_2 -> invalid_arg "external spin must be <= 1"
| BRS _ -> invalid_arg "no BRST"
in
{ code = code; sign = 0; coupl = M.pdg f;
lhs = lhs; rhs1 = rhs; rhs2 = rhs }
let print_external count flavor =
printi (load count (F.flavor flavor) count);
succ count
let print_externals amplitude =
printf "@\n@[<2>BEGIN EXTERNALS";
ignore (List.fold_left print_external 1 (F.externals amplitude));
printf "@]@\nEND EXTERNALS"
let print_current rhs =
match F.coupling rhs with
| V3 (vertex, fusion, constant) -> printf "@\nV3"
| V4 (vertex, fusion, constant) -> printf "@\nV4"
| Vn (_, _, _) -> printf "@\nVn"
let p2s p =
if p >= 0 && p <= 9 then
string_of_int p
else if p <= 36 then
String.make 1 (Char.chr (Char.code 'A' + p - 10))
else
"_"
let format_p wf =
String.concat "" (List.map p2s (F.momentum_list wf))
let print_fusion fusion =
let lhs = F.lhs fusion in
let f = F.flavor lhs in
(*i let momentum = format_p lhs in i*)
List.iter print_current (F.rhs fusion);
let propagate code =
printi { code = code; sign = 0; coupl = 0;
lhs = int_of_string (format_p lhs);
rhs1 = abs (M.pdg f); rhs2 = abs (M.pdg f) } in
match M.propagator f with
| Prop_Scalar -> propagate ovm_PROPAGATE_SCALAR
| Prop_Col_Scalar ->
failwith "print_fusion: Prop_Col_Scalar not implemented yet!"
| Prop_Ghost ->
failwith "print_fusion: Prop_Ghost not implemented yet!"
| Prop_Spinor -> propagate ovm_PROPAGATE_SPINOR
| Prop_ConjSpinor -> propagate ovm_PROPAGATE_CONJSPINOR
| Prop_Majorana | Prop_Col_Majorana ->
failwith "print_fusion: Prop_Majorana not implemented yet!"
| Prop_Unitarity -> propagate ovm_PROPAGATE_UNITARITY
| Prop_Col_Unitarity ->
failwith "print_fusion: Prop_Col_Unitarity not implemented yet!"
| Prop_Feynman -> propagate ovm_PROPAGATE_FEYNMAN
| Prop_Col_Feynman ->
failwith "print_fusion: Prop_Col_Feynman not implemented yet!"
| Prop_Gauge xi ->
failwith "print_fusion: Prop_Gauge not implemented yet!"
| Prop_Rxi xi ->
failwith "print_fusion: Prop_Rxi not implemented yet!"
| Prop_Vectorspinor ->
failwith "print_fusion: Prop_Vectorspinor not implemented yet!"
| Prop_Tensor_2 -> propagate ovm_PROPAGATE_TENSOR2
| Aux_Scalar | Aux_Spinor | Aux_ConjSpinor | Aux_Majorana
| Aux_Vector | Aux_Tensor_1 -> ()
| Only_Insertion -> ()
module P = Set.Make (struct type t = int list let compare = compare end)
let rec add_momenta lhs = function
| [] | [_] -> invalid_arg "add_momenta"
| [rhs1; rhs2] ->
printi { code = ovm_ADD_MOMENTA; sign = 0; coupl = 0;
lhs = int_of_string (format_p lhs);
rhs1 = int_of_string (format_p rhs1);
rhs2 = int_of_string (format_p rhs2) }
| rhs1 :: rhs ->
add_momenta lhs rhs;
add_momenta lhs [lhs; rhs1]
let print_fusions amplitude =
printf "@\n@[<2>BEGIN FUSIONS";
let momenta =
List.fold_left (fun seen f ->
let wf = F.lhs f in
let p = F.momentum_list wf in
let momentum = format_p wf in
if not (P.mem p seen) then
add_momenta wf (F.children (List.hd (F.rhs f)));
print_fusion f;
P.add p seen) P.empty (F.fusions amplitude)
in
printf "@]@\nEND FUSIONS"
let print_brakets amplitude =
printf "@\n@[<2>BEGIN BRAKETS";
printf "@\n!!! not implemented yet !!!";
printf "@]@\nEND BRAKETS"
let print_fudge_factor amplitude =
printf "@\n@[<2>BEGIN FUDGE";
printf "@\n!!! not implemented yet !!!";
printf "@]@\nEND FUDGE"
let amplitude_to_channel oc diagnostics amplitude =
set_formatter_out_channel oc;
printf "@\n@[<2>BEGIN AMPLITUDE %s" (format_process amplitude);
print_externals amplitude;
print_fusions amplitude;
print_brakets amplitude;
print_fudge_factor amplitude;
printf "@]@\nEND AMPLITUDE"
let amplitudes_to_channel oc diagnostics amplitudes =
List.iter (amplitude_to_channel oc diagnostics) (MF.allowed amplitudes)
let parameters_to_channel oc =
set_formatter_out_channel oc;
(*i let params = M.parameters () in i*)
printf "@[<2>BEGIN PARAMETERS@\n";
printf "!!! not implemented yet !!!@]@\n";
printf "END PARAMETERS@\n"
end
i*)
(*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 3998)
+++ trunk/src/omega/src/modellib_SM.ml (revision 3999)
@@ -1,3000 +1,3000 @@
(* $Id$
Copyright (C) 1999-2012 by
Wolfgang Kilian <kilian@physik.uni-siegen.de>
Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
Juergen Reuter <juergen.reuter@desy.de>
Christian Speckner <christian.speckner@physik.uni-freiburg.de>
Fabian Bach <fabian.bach@cern.ch> (only parts of this file)
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
(* Taking generation numbers makes electric charge redundant. *)
module Ch = Charges.ZZ
let charges = function
| 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 higgs_hmm : bool
val triple_anom : bool
val quartic_anom : bool
val higgs_anom : bool
val k_matrix : bool
val ckm_present : bool
val top_anom : bool
val top_anom_4f : bool
end
module SM_no_anomalous : SM_flags =
struct
let higgs_triangle = false
let higgs_hmm = false
let triple_anom = false
let quartic_anom = false
let higgs_anom = false
let k_matrix = false
let ckm_present = false
let top_anom = false
let top_anom_4f = false
end
module SM_no_anomalous_ckm : SM_flags =
struct
let higgs_triangle = false
let higgs_hmm = false
let triple_anom = false
let quartic_anom = false
let higgs_anom = false
let k_matrix = false
let ckm_present = true
let top_anom = false
let top_anom_4f = false
end
module SM_anomalous : SM_flags =
struct
let higgs_triangle = false
let higgs_hmm = false
let triple_anom = true
let quartic_anom = true
let higgs_anom = true
let k_matrix = false
let ckm_present = false
let top_anom = false
let top_anom_4f = false
end
module SM_anomalous_ckm : SM_flags =
struct
let higgs_triangle = false
let higgs_hmm = false
let triple_anom = true
let quartic_anom = true
let higgs_anom = true
let k_matrix = false
let ckm_present = true
let top_anom = false
let top_anom_4f = false
end
module SM_k_matrix : SM_flags =
struct
let higgs_triangle = false
let higgs_hmm = false
let triple_anom = false
let quartic_anom = true
let higgs_anom = false
let k_matrix = true
let ckm_present = false
let top_anom = false
let top_anom_4f = false
end
module SM_Higgs : SM_flags =
struct
let higgs_triangle = true
let higgs_hmm = true
let triple_anom = false
let quartic_anom = false
let higgs_anom = false
let k_matrix = false
let ckm_present = false
let top_anom = false
let top_anom_4f = false
end
module SM_anomalous_top : SM_flags =
struct
let higgs_triangle = false
let higgs_hmm = false
let triple_anom = false
let quartic_anom = false
let higgs_anom = false
let k_matrix = false
let ckm_present = false
let top_anom = true
let top_anom_4f = true
end
(* \thocwmodulesection{Complete Minimal Standard Model (including some extensions)} *)
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 f_aux_top = TTGG | TBWA | TBWZ | TTWW | BBWW | (*i top auxiliary field "flavors" *)
QGUG | QBUB | QW | DL | DR
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
| Aux_top of int*int*int*bool*f_aux_top (*i lorentz*color*charge*top-side*flavor *)
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 rec aux_top_flavors (f,l,co,ch) = List.append
( List.map other [ Aux_top(l,co,ch/2,true,f); Aux_top(l,co,ch/2,false,f) ] )
( if ch > 1 then List.append
( List.map other [ Aux_top(l,co,-ch/2,true,f); Aux_top(l,co,-ch/2,false,f) ] )
( aux_top_flavors (f,l,co,(ch-2)) )
else [] )
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 () = List.append
( ThoList.flatmap snd (external_flavors ()) )
( ThoList.flatmap aux_top_flavors
[ (TTGG,2,1,1); (TBWA,2,0,2); (TBWZ,2,0,2); (TTWW,2,0,1); (BBWW,2,0,1);
(QGUG,1,1,1); (QBUB,1,0,1); (QW,1,0,3); (DL,0,0,3); (DR,0,0,3) ] )
let spinor n =
if n >= 0 then
Spinor
else
ConjSpinor
let lorentz_aux = function
| 2 -> Tensor_1
| 1 -> Vector
| 0 -> Scalar
| _ -> invalid_arg ("SM.lorentz_aux: wrong value")
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
| Aux_top (l,_,_,_,_) -> lorentz_aux l
| _ -> 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
| O (Aux_top (_,co,_,_,_)) -> if co == 0 then Color.Singlet else Color.AdjSUN 3
| _ -> Color.Singlet
let prop_spinor n =
if n >= 0 then
Prop_Spinor
else
Prop_ConjSpinor
let prop_aux = function
| 2 -> Aux_Tensor_1
| 1 -> Aux_Vector
| 0 -> Aux_Scalar
| _ -> invalid_arg ("SM.prop_aux: wrong value")
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
| Aux_top (l,_,_,_,_) -> prop_aux l
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
| Aux_top (l,co,ch,n,f) -> Aux_top (l,co,(-ch),(not n),f)
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
| Aux_top (_,_,ch,_,_) -> ch//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 | Half | Pi | Alpha_QED | Sin2thw
| Sinthw | Costhw | E | G_weak | I_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
| G_TVA_ttA | G_TVA_bbA
| G_VLR_ttZ | G_TVA_ttZ | G_TVA_bbZ
| G_VLR_btW | G_VLR_tbW
| G_TLR_btW | G_TRL_tbW
| G_TLR_btWZ | G_TRL_tbWZ
| G_TLR_btWA | G_TRL_tbWA
| G_TVA_ttWW | G_TVA_bbWW
| G_TVA_ttG | G_TVA_ttGG
| G_SP_ttH
| G_VLR_qGuG | G_VLR_qBuB
| G_VLR_qBuB_u | G_VLR_qBuB_d | G_VLR_qBuB_e | G_VL_qBuB_n
| G_VL_qW | G_VL_qW_u | G_VL_qW_d
| G_SL_DttR | G_SR_DttR | G_SL_DttL | G_SLR_DbtR | G_SL_DbtL
| 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
| G_HGaZ_anom | G_HGaGa_anom | G_HZZ_anom | G_HWW_anom
| G_HGaZ_u | G_HZZ_u | G_HWW_u
| 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_weak, Prod [I; Atom G_weak];
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 mom ((m1, o, m2), fbf, c) = ((M m1, O o, 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 (-3)), O H, M (L 3)), FBF (1, Psibar, S, Psi), G_Htautau) ] @
if Flags.higgs_hmm then
[ ((M (L (-2)), O H, M (L 2)), FBF (1, Psibar, S, Psi), G_Hmm)]
else
[]
(* \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)]
(* \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_L5 (-1),
I_kappa5_AWW);
((Z, Wm, Wp), Dim4_Vector_Vector_Vector_L5 (-1),
I_kappa5_ZWW);
((Ga, Wm, Wp), Dim4_Vector_Vector_Vector_T5 (-1),
G5_AWW);
((Z, Wm, Wp), Dim4_Vector_Vector_Vector_T5 (-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 (0, [K_Matrix_Coeff 0,
K_Matrix_Pole 0]), Alpha_WWWW0);
((Wm, Wm, Wp, Wp), Vector4_K_Matrix_tho (0, [K_Matrix_Coeff 2,
K_Matrix_Pole 2]), Alpha_WWWW2);
((Wm, Wp, Z, Z), Vector4_K_Matrix_tho (0, [(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 (0, [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 =
[ (O H, G Ga, G Ga), Dim5_Scalar_Gauge2 1, G_HGaGa_anom;
(O H, G Ga, G Z), Dim5_Scalar_Gauge2 1, G_HGaZ_anom;
(O H, G Z, G Z), Dim5_Scalar_Gauge2 1, G_HZZ_anom;
(O H, G Wp, G Wm), Dim5_Scalar_Gauge2 1, G_HWW_anom;
- (O H, G Ga, G Z), Dim5_Scalar_Vector_Vector_U 1, G_HGaZ_u;
+ (O H, G Ga, G Z), Dim5_Scalar_Vector_Vector_TU 1, G_HGaZ_u;
(O H, G Z, G Z), Dim5_Scalar_Vector_Vector_U 1, G_HZZ_u;
(O H, G Wp, G Wm), Dim5_Scalar_Vector_Vector_U 1, G_HWW_u
]
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) ]
(* Anomalous trilinear interactions $f_i f_j V$ and $ttH$:
\begin{equation}
\Delta\mathcal{L}_{tt\gamma} =
- e \frac{\upsilon}{\Lambda^2}
\bar{t} i\sigma^{\mu\nu} k_\nu (d_V(k^2) + i d_A(k^2) \gamma_5) t A_\mu
\end{equation} *)
let anomalous_ttA =
if Flags.top_anom then
[ ((M (U (-3)), G Ga, M (U 3)), FBF (1, Psibar, TVAM, Psi), G_TVA_ttA) ]
else
[]
(* \begin{equation}
\Delta\mathcal{L}_{bb\gamma} =
- e \frac{\upsilon}{\Lambda^2}
\bar{b} i\sigma^{\mu\nu} k_\nu (d_V(k^2) + i d_A(k^2) \gamma_5) b A_\mu
\end{equation} *)
let anomalous_bbA =
if Flags.top_anom then
[ ((M (D (-3)), G Ga, M (D 3)), FBF (1, Psibar, TVAM, Psi), G_TVA_bbA) ]
else
[]
(* \begin{equation}
\Delta\mathcal{L}_{ttg} =
- g_s \frac{\upsilon}{\Lambda^2}
\bar{t}\lambda^a i\sigma^{\mu\nu}k_\nu
(d_V(k^2)+id_A(k^2)\gamma_5)tG^a_\mu
\end{equation} *)
let anomalous_ttG =
if Flags.top_anom then
[ ((M (U (-3)), G Gl, M (U 3)), FBF (1, Psibar, TVAM, Psi), G_TVA_ttG) ]
else
[]
(* \begin{equation}
\Delta\mathcal{L}_{ttZ} =
- \frac{g}{2 c_W} \frac{\upsilon^2}{\Lambda^2}\left\lbrack
\bar{t} \fmslash{Z} (X_L(k^2) P_L + X_R(k^2) P_R) t
+ \bar{t}\frac{i\sigma^{\mu\nu}k_\nu}{m_Z}
(d_V(k^2)+id_A(k^2)\gamma_5)tZ_\mu\right\rbrack
\end{equation} *)
let anomalous_ttZ =
if Flags.top_anom then
[ ((M (U (-3)), G Z, M (U 3)), FBF (1, Psibar, VLRM, Psi), G_VLR_ttZ);
((M (U (-3)), G Z, M (U 3)), FBF (1, Psibar, TVAM, Psi), G_TVA_ttZ) ]
else
[]
(* \begin{equation}
\Delta\mathcal{L}_{bbZ} =
- \frac{g}{2 c_W} \frac{\upsilon^2}{\Lambda^2}
\bar{b}\frac{i\sigma^{\mu\nu}k_\nu}{m_Z}
(d_V(k^2)+id_A(k^2)\gamma_5)bZ_\mu
\end{equation} *)
let anomalous_bbZ =
if Flags.top_anom then
[ ((M (D (-3)), G Z, M (D 3)), FBF (1, Psibar, TVAM, Psi), G_TVA_bbZ) ]
else
[]
(* \begin{equation}
\Delta\mathcal{L}_{tbW} =
- \frac{g}{\sqrt{2}} \frac{\upsilon^2}{\Lambda^2}\left\lbrack
\bar{b}\fmslash{W}^-(V_L(k^2) P_L+V_R(k^2) P_R) t
+ \bar{b}\frac{i\sigma^{\mu\nu}k_\nu}{m_W}
(g_L(k^2)P_L+g_R(k^2)P_R)tW^-_\mu\right\rbrack
+ \textnormal{H.c.}
\end{equation} *)
let anomalous_tbW =
if Flags.top_anom then
[ ((M (D (-3)), G Wm, M (U 3)), FBF (1, Psibar, VLRM, Psi), G_VLR_btW);
((M (U (-3)), G Wp, M (D 3)), FBF (1, Psibar, VLRM, Psi), G_VLR_tbW);
((M (D (-3)), G Wm, M (U 3)), FBF (1, Psibar, TLRM, Psi), G_TLR_btW);
((M (U (-3)), G Wp, M (D 3)), FBF (1, Psibar, TRLM, Psi), G_TRL_tbW) ]
else
[]
(* \begin{equation}
\Delta\mathcal{L}_{ttH} =
- \frac{1}{\sqrt{2}} \bar{t} (Y_V(k^2)+iY_A(k^2)\gamma_5)t H
\end{equation} *)
let anomalous_ttH =
if Flags.top_anom then
[ ((M (U (-3)), O H, M (U 3)), FBF (1, Psibar, SPM, Psi), G_SP_ttH) ]
else
[]
(* quartic fermion-gauge interactions $f_i f_j V_1 V_2$ emerging from gauge-invariant
effective operators:
\begin{equation}
\Delta\mathcal{L}_{ttgg} =
- \frac{g_s^2}{2} f_{abc} \frac{\upsilon}{\Lambda^2}
\bar{t} \lambda^a \sigma^{\mu\nu}
(d_V(k^2)+id_A(k^2)\gamma_5)t G^b_\mu G^c_\nu
\end{equation} *)
let anomalous_ttGG =
if Flags.top_anom then
[ ((M (U (-3)), O (Aux_top (2,1,0,true,TTGG)), M (U 3)), FBF (1, Psibar, TVA, Psi), G_TVA_ttGG);
((O (Aux_top (2,1,0,false,TTGG)), G Gl, G Gl), Aux_Gauge_Gauge 1, I_Gs) ]
else
[]
(* \begin{equation}
\Delta\mathcal{L}_{tbWA} =
- i\sin\theta_w \frac{g^2}{2\sqrt{2}} \frac{\upsilon^2}{\Lambda^2}\left\lbrack
\bar{b}\frac{\sigma^{\mu\nu}}{m_W}
(g_L(k^2)P_L+g_R(k^2)P_R)t A_\mu W^-_\nu \right\rbrack
+ \textnormal{H.c.}
\end{equation} *)
let anomalous_tbWA =
if Flags.top_anom then
[ ((M (D (-3)), O (Aux_top (2,0,-1,true,TBWA)), M (U 3)), FBF (1, Psibar, TLR, Psi), G_TLR_btWA);
((O (Aux_top (2,0,1,false,TBWA)), G Ga, G Wm), Aux_Gauge_Gauge 1, I_G_weak);
((M (U (-3)), O (Aux_top (2,0,1,true,TBWA)), M (D 3)), FBF (1, Psibar, TRL, Psi), G_TRL_tbWA);
((O (Aux_top (2,0,-1,false,TBWA)), G Wp, G Ga), Aux_Gauge_Gauge 1, I_G_weak) ]
else
[]
(* \begin{equation}
\Delta\mathcal{L}_{tbWZ} =
- i\cos\theta_w \frac{g^2}{2\sqrt{2}} \frac{\upsilon^2}{\Lambda^2}\left\lbrack
\bar{b}\frac{\sigma^{\mu\nu}}{m_W}
(g_L(k^2)P_L+g_R(k^2)P_R)t Z_\mu W^-_\nu \right\rbrack
+ \textnormal{H.c.}
\end{equation} *)
let anomalous_tbWZ =
if Flags.top_anom then
[ ((M (D (-3)), O (Aux_top (2,0,-1,true,TBWZ)), M (U 3)), FBF (1, Psibar, TLR, Psi), G_TLR_btWZ);
((O (Aux_top (2,0,1,false,TBWZ)), G Z, G Wm), Aux_Gauge_Gauge 1, I_G_weak);
((M (U (-3)), O (Aux_top (2,0,1,true,TBWZ)), M (D 3)), FBF (1, Psibar, TRL, Psi), G_TRL_tbWZ);
((O (Aux_top (2,0,-1,false,TBWZ)), G Wp, G Z), Aux_Gauge_Gauge 1, I_G_weak) ]
else
[]
(* \begin{equation}
\Delta\mathcal{L}_{ttWW} =
- i \frac{g^2}{2} \frac{\upsilon^2}{\Lambda^2}
\bar{t} \frac{\sigma^{\mu\nu}}{m_W}
(d_V(k^2)+id_A(k^2)\gamma_5)t W^-_\mu W^+_\nu
\end{equation} *)
let anomalous_ttWW =
if Flags.top_anom then
[ ((M (U (-3)), O (Aux_top (2,0,0,true,TTWW)), M (U 3)), FBF (1, Psibar, TVA, Psi), G_TVA_ttWW);
((O (Aux_top (2,0,0,false,TTWW)), G Wm, G Wp), Aux_Gauge_Gauge 1, I_G_weak) ]
else
[]
(* \begin{equation}
\Delta\mathcal{L}_{bbWW} =
- i \frac{g^2}{2} \frac{\upsilon^2}{\Lambda^2}
\bar{b} \frac{\sigma^{\mu\nu}}{m_W}
(d_V(k^2)+id_A(k^2)\gamma_5)b W^-_\mu W^+_\nu
\end{equation} *)
let anomalous_bbWW =
if Flags.top_anom then
[ ((M (D (-3)), O (Aux_top (2,0,0,true,BBWW)), M (D 3)), FBF (1, Psibar, TVA, Psi), G_TVA_bbWW);
((O (Aux_top (2,0,0,false,BBWW)), G Wm, G Wp), Aux_Gauge_Gauge 1, I_G_weak) ]
else
[]
(* 4-fermion contact terms emerging from operator rewriting: *)
let anomalous_top_qGuG_tt =
[ ((M (U (-3)), O (Aux_top (1,1,0,true,QGUG)), M (U 3)), FBF (1, Psibar, VLR, Psi), G_VLR_qGuG) ]
let anomalous_top_qGuG_ff n =
List.map mom
[ ((U (-n), Aux_top (1,1,0,false,QGUG), U n), FBF (1, Psibar, V, Psi), Unit);
((D (-n), Aux_top (1,1,0,false,QGUG), D n), FBF (1, Psibar, V, Psi), Unit) ]
let anomalous_top_qGuG =
if Flags.top_anom_4f then
anomalous_top_qGuG_tt @ ThoList.flatmap anomalous_top_qGuG_ff [1;2;3]
else
[]
let anomalous_top_qBuB_tt =
[ ((M (U (-3)), O (Aux_top (1,0,0,true,QBUB)), M (U 3)), FBF (1, Psibar, VLR, Psi), G_VLR_qBuB) ]
let anomalous_top_qBuB_ff n =
List.map mom
[ ((U (-n), Aux_top (1,0,0,false,QBUB), U n), FBF (1, Psibar, VLR, Psi), G_VLR_qBuB_u);
((D (-n), Aux_top (1,0,0,false,QBUB), D n), FBF (1, Psibar, VLR, Psi), G_VLR_qBuB_d);
((L (-n), Aux_top (1,0,0,false,QBUB), L n), FBF (1, Psibar, VLR, Psi), G_VLR_qBuB_e);
((N (-n), Aux_top (1,0,0,false,QBUB), N n), FBF (1, Psibar, VL, Psi), G_VL_qBuB_n) ]
let anomalous_top_qBuB =
if Flags.top_anom_4f then
anomalous_top_qBuB_tt @ ThoList.flatmap anomalous_top_qBuB_ff [1;2;3]
else
[]
let anomalous_top_qW_tq =
[ ((M (U (-3)), O (Aux_top (1,0,0,true,QW)), M (U 3)), FBF (1, Psibar, VL, Psi), G_VL_qW);
((M (D (-3)), O (Aux_top (1,0,-1,true,QW)), M (U 3)), FBF (1, Psibar, VL, Psi), G_VL_qW);
((M (U (-3)), O (Aux_top (1,0,1,true,QW)), M (D 3)), FBF (1, Psibar, VL, Psi), G_VL_qW) ]
let anomalous_top_qW_ff n =
List.map mom
[ ((U (-n), Aux_top (1,0,0,false,QW), U n), FBF (1, Psibar, VL, Psi), G_VL_qW_u);
((D (-n), Aux_top (1,0,0,false,QW), D n), FBF (1, Psibar, VL, Psi), G_VL_qW_d);
((N (-n), Aux_top (1,0,0,false,QW), N n), FBF (1, Psibar, VL, Psi), G_VL_qW_u);
((L (-n), Aux_top (1,0,0,false,QW), L n), FBF (1, Psibar, VL, Psi), G_VL_qW_d);
((D (-n), Aux_top (1,0,-1,false,QW), U n), FBF (1, Psibar, VL, Psi), Half);
((U (-n), Aux_top (1,0,1,false,QW), D n), FBF (1, Psibar, VL, Psi), Half);
((L (-n), Aux_top (1,0,-1,false,QW), N n), FBF (1, Psibar, VL, Psi), Half);
((N (-n), Aux_top (1,0,1,false,QW), L n), FBF (1, Psibar, VL, Psi), Half) ]
let anomalous_top_qW =
if Flags.top_anom_4f then
anomalous_top_qW_tq @ ThoList.flatmap anomalous_top_qW_ff [1;2;3]
else
[]
let anomalous_top_DuDd =
if Flags.top_anom_4f then
[ ((M (U (-3)), O (Aux_top (0,0,0,true,DR)), M (U 3)), FBF (1, Psibar, SR, Psi), Half);
((M (U (-3)), O (Aux_top (0,0,0,false,DR)), M (U 3)), FBF (1, Psibar, SL, Psi), G_SL_DttR);
((M (D (-3)), O (Aux_top (0,0,0,false,DR)), M (D 3)), FBF (1, Psibar, SR, Psi), G_SR_DttR);
((M (U (-3)), O (Aux_top (0,0,0,true,DL)), M (U 3)), FBF (1, Psibar, SL, Psi), Half);
((M (D (-3)), O (Aux_top (0,0,0,false,DL)), M (D 3)), FBF (1, Psibar, SL, Psi), G_SL_DttL);
((M (D (-3)), O (Aux_top (0,0,-1,true,DR)), M (U 3)), FBF (1, Psibar, SR, Psi), Half);
((M (U (-3)), O (Aux_top (0,0,1,false,DR)), M (D 3)), FBF (1, Psibar, SLR, Psi), G_SLR_DbtR);
((M (D (-3)), O (Aux_top (0,0,-1,true,DL)), M (U 3)), FBF (1, Psibar, SL, Psi), Half);
((M (U (-3)), O (Aux_top (0,0,1,false,DL)), M (D 3)), FBF (1, Psibar, SL, Psi), G_SL_DbtL) ]
else
[]
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 @
anomalous_ttA @ anomalous_bbA @
anomalous_ttZ @ anomalous_bbZ @
anomalous_tbW @ anomalous_tbWA @ anomalous_tbWZ @
anomalous_ttWW @ anomalous_bbWW @
anomalous_ttG @ anomalous_ttGG @
anomalous_ttH @
anomalous_top_qGuG @ anomalous_top_qBuB @
anomalous_top_qW @ anomalous_top_DuDd)
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
| "Aux_t_ttGG0" -> O (Aux_top (2,1, 0,true,TTGG)) | "Aux_ttGG0" -> O (Aux_top (2,1, 0,false,TTGG))
| "Aux_t_tbWA+" -> O (Aux_top (2,0, 1,true,TBWA)) | "Aux_tbWA+" -> O (Aux_top (2,0, 1,false,TBWA))
| "Aux_t_tbWA-" -> O (Aux_top (2,0,-1,true,TBWA)) | "Aux_tbWA-" -> O (Aux_top (2,0,-1,false,TBWA))
| "Aux_t_tbWZ+" -> O (Aux_top (2,0, 1,true,TBWZ)) | "Aux_tbWZ+" -> O (Aux_top (2,0, 1,false,TBWZ))
| "Aux_t_tbWZ-" -> O (Aux_top (2,0,-1,true,TBWZ)) | "Aux_tbWZ-" -> O (Aux_top (2,0,-1,false,TBWZ))
| "Aux_t_ttWW0" -> O (Aux_top (2,0, 0,true,TTWW)) | "Aux_ttWW0" -> O (Aux_top (2,0, 0,false,TTWW))
| "Aux_t_bbWW0" -> O (Aux_top (2,0, 0,true,BBWW)) | "Aux_bbWW0" -> O (Aux_top (2,0, 0,false,BBWW))
| "Aux_t_qGuG0" -> O (Aux_top (1,1, 0,true,QGUG)) | "Aux_qGuG0" -> O (Aux_top (1,1, 0,false,QGUG))
| "Aux_t_qBuB0" -> O (Aux_top (1,0, 0,true,QBUB)) | "Aux_qBuB0" -> O (Aux_top (1,0, 0,false,QBUB))
| "Aux_t_qW0" -> O (Aux_top (1,0, 0,true,QW)) | "Aux_qW0" -> O (Aux_top (1,0, 0,false,QW))
| "Aux_t_qW+" -> O (Aux_top (1,0, 1,true,QW)) | "Aux_qW+" -> O (Aux_top (1,0, 1,false,QW))
| "Aux_t_qW-" -> O (Aux_top (1,0,-1,true,QW)) | "Aux_qW-" -> O (Aux_top (1,0,-1,false,QW))
| "Aux_t_dL0" -> O (Aux_top (0,0, 0,true,DL)) | "Aux_dL0" -> O (Aux_top (0,0, 0,false,DL))
| "Aux_t_dL+" -> O (Aux_top (0,0, 1,true,DL)) | "Aux_dL+" -> O (Aux_top (0,0, 1,false,DL))
| "Aux_t_dL-" -> O (Aux_top (0,0,-1,true,DL)) | "Aux_dL-" -> O (Aux_top (0,0,-1,false,DL))
| "Aux_t_dR0" -> O (Aux_top (0,0, 0,true,DR)) | "Aux_dR0" -> O (Aux_top (0,0, 0,false,DR))
| "Aux_t_dR+" -> O (Aux_top (0,0, 1,true,DR)) | "Aux_dR+" -> O (Aux_top (0,0, 1,false,DR))
| "Aux_t_dR-" -> O (Aux_top (0,0,-1,true,DR)) | "Aux_dR-" -> O (Aux_top (0,0,-1,false,DR))
| _ -> 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"
| Aux_top (_,_,ch,n,v) -> "Aux_" ^ (if n then "t_" else "") ^ (
begin match v with
| TTGG -> "ttGG" | TBWA -> "tbWA" | TBWZ -> "tbWZ"
| TTWW -> "ttWW" | BBWW -> "bbWW"
| QGUG -> "qGuG" | QBUB -> "qBuB"
| QW -> "qW" | DL -> "dL" | DR -> "dR"
end ) ^ ( if ch > 0 then "+" else if ch < 0 then "-" else "0" )
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"
| Aux_top (_,_,ch,n,v) -> "\\textnormal{Aux_" ^ (if n then "t_" else "") ^ (
begin match v with
| TTGG -> "ttGG" | TBWA -> "tbWA" | TBWZ -> "tbWZ"
| TTWW -> "ttWW" | BBWW -> "bbWW"
| QGUG -> "qGuG" | QBUB -> "qBuB"
| QW -> "qW" | DL -> "dL" | DR -> "dR"
end ) ^ ( if ch > 0 then "^+" else if ch < 0 then "^-" else "^0" ) ^ "}"
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"
| Aux_top (_,_,ch,n,v) -> "aux_" ^ (if n then "t_" else "") ^ (
begin match v with
| TTGG -> "ttgg" | TBWA -> "tbwa" | TBWZ -> "tbwz"
| TTWW -> "ttww" | BBWW -> "bbww"
| QGUG -> "qgug" | QBUB -> "qbub"
| QW -> "qw" | DL -> "dl" | DR -> "dr"
end ) ^ "_" ^ ( if ch > 0 then "p" else if ch < 0 then "m" else "0" )
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
| Aux_top (_,_,_,_,_) -> 81
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" | Half -> "half" | Pi -> "PI"
| Alpha_QED -> "alpha" | E -> "e" | G_weak -> "g" | Vev -> "vev"
| I_G_weak -> "ig"
| 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_TVA_ttA -> "gtva_tta" | G_TVA_bbA -> "gtva_bba"
| G_VLR_ttZ -> "gvlr_ttz" | G_TVA_ttZ -> "gtva_ttz" | G_TVA_bbZ -> "gtva_bbz"
| G_VLR_btW -> "gvlr_btw" | G_VLR_tbW -> "gvlr_tbw"
| G_TLR_btW -> "gtlr_btw" | G_TRL_tbW -> "gtrl_tbw"
| G_TLR_btWA -> "gtlr_btwa" | G_TRL_tbWA -> "gtrl_tbwa"
| G_TLR_btWZ -> "gtlr_btwz" | G_TRL_tbWZ -> "gtrl_tbwz"
| G_TVA_ttWW -> "gtva_ttww" | G_TVA_bbWW -> "gtva_bbww"
| G_TVA_ttG -> "gtva_ttg" | G_TVA_ttGG -> "gtva_ttgg"
| G_SP_ttH -> "gsp_tth"
| G_VLR_qGuG -> "gvlr_qgug"
| G_VLR_qBuB -> "gvlr_qbub"
| G_VLR_qBuB_u -> "gvlr_qbub_u" | G_VLR_qBuB_d -> "gvlr_qbub_d"
| G_VLR_qBuB_e -> "gvlr_qbub_e" | G_VL_qBuB_n -> "gvl_qbub_n"
| G_VL_qW -> "gvl_qw"
| G_VL_qW_u -> "gvl_qw_u" | G_VL_qW_d -> "gvl_qw_d"
| G_SL_DttR -> "gsl_dttr" | G_SR_DttR -> "gsr_dttr" | G_SL_DttL -> "gsl_dttl"
| G_SLR_DbtR -> "gslr_dbtr" | G_SL_DbtL -> "gsl_dbtl"
| 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_HGaGa_anom -> "ghgaga_ac" | G_HGaZ_anom -> "ghgaz_ac"
| G_HZZ_anom -> "ghzz_ac" | G_HWW_anom -> "ghww_ac"
| G_HGaZ_u -> "ghgaz_u" | G_HZZ_u -> "ghzz_u"
| G_HWW_u -> "ghww_u"
| 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 = 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{QCD with electroweak insertions.} *)
module SM_QCD =
struct
let rcs = RCS.rename rcs_file "Modellib.SM_QCD"
[ "QCD with electroweak insertions"]
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 | GaX | Wp | Wm | Z | Gl
type other = 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_QCD.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; GaX; Z; Wp; Wm; Gl];
"Higgs", List.map other [H] ]
let flavors () = ThoList.flatmap snd (external_flavors ())
let spinor n =
if n >= 0 then
Spinor
else
ConjSpinor
let lorentz_aux = function
| 2 -> Tensor_1
| 1 -> Vector
| 0 -> Scalar
| _ -> invalid_arg ("SM_QCD.lorentz_aux: wrong value")
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 | GaX | Gl -> Vector
| Wp | Wm | Z -> Massive_Vector
end
| O f ->
begin match f with
| _ -> 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 prop_aux = function
| 2 -> Aux_Tensor_1
| 1 -> Aux_Vector
| 0 -> Aux_Scalar
| _ -> invalid_arg ("SM_QCD.prop_aux: wrong value")
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 | GaX | Gl -> Prop_Feynman
| Wp | Wm | Z -> Prop_Unitarity
end
| O f ->
begin match f with
| 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 _ = 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 -> GaX | Z -> Z
| GaX -> Ga | Wp -> Wm | Wm -> Wp
end)
| O f ->
O (begin match f with
| 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 | GaX | 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_QCD.generation': " ^ string_of_int n)
let generation f =
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 | GaX | Z -> 0//1
| Wp -> 1//1
| Wm -> -1//1
end
| O f ->
begin match f with
| H -> 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 | Half | Pi | Alpha_QED | Sin2thw
| Sinthw | Costhw | E | G_weak | I_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 | G_Htt | G_Hbb | G_Hcc | G_Hmm | G_Htautau
| Gs | I_Gs | G2
| Mass of flavor | Width of flavor
(* \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 ]
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]]
let g_over_2_costh =
Quot (Neg (Atom G_weak), Prod [Const 2; Atom Costhw])
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)
let mgm ((m1, g, m2), fbf, c) = ((M m1, G g, M m2), fbf, c)
let mom ((m1, o, m2), fbf, c) = ((M m1, O o, M m2), fbf, c)
let electromagnetic_currents n =
List.map mgm
[ ((L (-n), GaX, 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 triple_gauge =
List.map tgc
[ ((Gl, Gl, Gl), Gauge_Gauge_Gauge 1, I_Gs)]
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 quartic_gauge =
List.map qgc
[ (Gl, Gl, Gl, Gl), gauge4, G2 ]
let vertices3 =
(ThoList.flatmap electromagnetic_currents [1;2;3] @
ThoList.flatmap color_currents [1;2;3] @
ThoList.flatmap neutral_currents [1;2;3] @
charged_currents_triv @
yukawa @ triple_gauge)
let vertices4 =
quartic_gauge
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_QCD.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_QCD.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_QCD.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_QCD.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_QCD.flavor_to_string: invalid down type quark"
end
| G f ->
begin match f with
| Gl -> "gl"
| Ga | GaX -> "A" | Z -> "Z"
| Wp -> "W+" | Wm -> "W-"
end
| O f ->
begin match f with
| 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_QCD.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_QCD.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_QCD.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_QCD.flavor_to_TeX: invalid down type quark"
end
| G f ->
begin match f with
| Gl -> "g"
| Ga | GaX -> "\\gamma" | Z -> "Z"
| Wp -> "W^+" | Wm -> "W^-"
end
| O f ->
begin match f with
| 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"
| GaX -> "gax"
| Wp -> "wp" | Wm -> "wm"
end
| O f ->
begin match f with
| 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 | GaX -> 22 | Z -> 23
| Wp -> 24 | Wm -> (-24)
end
| O f ->
begin match f with
| 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" | Half -> "half" | Pi -> "PI"
| Alpha_QED -> "alpha" | E -> "e" | G_weak -> "g" | Vev -> "vev"
| I_G_weak -> "ig"
| 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"
| G_Htt -> "ghtt" | G_Hbb -> "ghbb"
| G_Htautau -> "ghtautau" | G_Hcc -> "ghcc" | G_Hmm -> "ghmm"
| Gs -> "gs" | I_Gs -> "igs" | G2 -> "gs**2"
| Mass f -> "mass" ^ flavor_symbol f
| Width f -> "width" ^ flavor_symbol f
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))
(*i
* Local Variables:
* mode:caml
* indent-tabs-mode:nil
* page-delimiter:"^(\\* .*\n"
* End:
i*)
Index: trunk/src/omega/src/colorize.ml
===================================================================
--- trunk/src/omega/src/colorize.ml (revision 3998)
+++ trunk/src/omega/src/colorize.ml (revision 3999)
@@ -1,1469 +1,1471 @@
(* $Id$
Copyright (C) 1999-2012 by
Wolfgang Kilian <kilian@physik.uni-siegen.de>
Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
Juergen Reuter <juergen.reuter@desy.de>
Christian Speckner <christian.speckner@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 "Colorize" ["Colorizing Monochrome Models"]
{ RCS.revision = "$Revision$";
RCS.date = "$Date$";
RCS.author = "$Author$";
RCS.source
= "$URL$" }
(* \thocwmodulesection{Colorizing a Monochrome Model} *)
module It (M : Model.T) =
struct
let rcs = RCS.rename rcs_file "Colorize.It()"
[ "Colorizing Generic Monochrome Models"]
open Coupling
module C = Color
let incomplete s =
failwith ("Colorize.It()." ^ s ^ " not done yet!")
let invalid s =
invalid_arg ("Colorize.It()." ^ s ^ " must not be evaluated!")
let impossible s =
invalid_arg ("Colorize.It()." ^ s ^ " can't happen! (but just did ...)")
let su0 s =
invalid_arg ("Colorize.It()." ^ s ^ ": found SU(0)!")
let colored_vertex s =
invalid_arg ("Colorize.It()." ^ s ^ ": colored vertex!")
let baryonic_vertex s =
invalid_arg ("Colorize.It()." ^ s ^
": baryonic (i.e. eps_ijk) vertices not supported yet!")
let color_flow_ambiguous s =
invalid_arg ("Colorize.It()." ^ s ^ ": ambiguous color flow!")
let color_flow_of_string s =
let c = int_of_string s in
if c < 1 then
invalid_arg ("Colorize.It()." ^ s ^ ": color flow # < 1!")
else
c
type cf_in = int
type cf_out = int
type flavor =
| White of M.flavor
| CF_in of M.flavor * cf_in
| CF_out of M.flavor * cf_out
| CF_io of M.flavor * cf_in * cf_out
| CF_aux of M.flavor
type flavor_sans_color = M.flavor
let flavor_sans_color = function
| White f -> f
| CF_in (f, _) -> f
| CF_out (f, _) -> f
| CF_io (f, _, _) -> f
| CF_aux f -> f
let pullback f arg1 =
f (flavor_sans_color arg1)
type gauge = M.gauge
type constant = M.constant
let options = M.options
let color = pullback M.color
let pdg = pullback M.pdg
let lorentz = pullback M.lorentz
module Ch = M.Ch
let charges = pullback M.charges
(* For the propagator we cannot use pullback because we have to add the case
of the color singlet propagator by hand. *)
let cf_aux_propagator = function
| Prop_Scalar -> Prop_Col_Scalar (* Spin 0 octets. *)
| Prop_Majorana -> Prop_Col_Majorana (* Spin 1/2 octets. *)
| Prop_Feynman -> Prop_Col_Feynman (* Spin 1 states, massless. *)
| Prop_Unitarity -> Prop_Col_Unitarity (* Spin 1 states, massive. *)
| Aux_Vector -> Aux_Col_Vector (* constant colored vector propagator *)
| Aux_Tensor_1 -> Aux_Col_Tensor_1 (* constant colored tensor propagator *)
| Prop_Col_Scalar | Prop_Col_Feynman
| Prop_Col_Majorana | Prop_Col_Unitarity
| Aux_Col_Vector | Aux_Col_Tensor_1
-> failwith ("Colorize.It().colorize_propagator: already colored particle!")
| _ -> failwith ("Colorize.It().colorize_propagator: impossible!")
let propagator = function
| CF_aux f -> cf_aux_propagator (M.propagator f)
| White f -> M.propagator f
| CF_in (f, _) -> M.propagator f
| CF_out (f, _) -> M.propagator f
| CF_io (f, _, _) -> M.propagator f
let width = pullback M.width
let goldstone = function
| White f ->
begin match M.goldstone f with
| None -> None
| Some (f', g) -> Some (White f', g)
end
| CF_in (f, c) ->
begin match M.goldstone f with
| None -> None
| Some (f', g) -> Some (CF_in (f', c), g)
end
| CF_out (f, c) ->
begin match M.goldstone f with
| None -> None
| Some (f', g) -> Some (CF_out (f', c), g)
end
| CF_io (f, c1, c2) ->
begin match M.goldstone f with
| None -> None
| Some (f', g) -> Some (CF_io (f', c1, c2), g)
end
| CF_aux f ->
begin match M.goldstone f with
| None -> None
| Some (f', g) -> Some (CF_aux f', g)
end
let conjugate = function
| White f -> White (M.conjugate f)
| CF_in (f, c) -> CF_out (M.conjugate f, c)
| CF_out (f, c) -> CF_in (M.conjugate f, c)
| CF_io (f, c1, c2) -> CF_io (M.conjugate f, c2, c1)
| CF_aux f -> CF_aux (M.conjugate f)
let conjugate_sans_color = M.conjugate
let fermion = pullback M.fermion
let max_degree = M.max_degree
let flavors () =
invalid "flavors"
let external_flavors () =
invalid "external_flavors"
let parameters = M.parameters
module ISet = Set.Make (struct type t = int let compare = compare end)
let nc_value =
let nc_set =
List.fold_left
(fun nc_set f ->
match M.color f with
| C.Singlet -> nc_set
| C.SUN nc -> ISet.add (abs nc) nc_set
| C.AdjSUN nc -> ISet.add (abs nc) nc_set)
ISet.empty (M.flavors ()) in
match ISet.elements nc_set with
| [] -> 0
| [n] -> n
| nc_list ->
invalid_arg
("Colorize.It(): more than one value of N_C: " ^
String.concat ", " (List.map string_of_int nc_list))
let nc () =
nc_value
let split_color_string s =
try
let i1 = String.index s '/' in
let i2 = String.index_from s (succ i1) '/' in
let sf = String.sub s 0 i1
and sc1 = String.sub s (succ i1) (i2 - i1 - 1)
and sc2 = String.sub s (succ i2) (String.length s - i2 - 1) in
(sf, sc1, sc2)
with
| Not_found -> (s, "", "")
let flavor_of_string s =
try
let sf, sc1, sc2 = split_color_string s in
let f = M.flavor_of_string sf in
match M.color f with
| C.Singlet -> White f
| C.SUN nc ->
if nc > 0 then
CF_in (f, color_flow_of_string sc1)
else
CF_out (f, color_flow_of_string sc2)
| C.AdjSUN _ ->
begin match sc1, sc2 with
| "", "" -> CF_aux f
| _, _ -> CF_io (f, color_flow_of_string sc1, color_flow_of_string sc2)
end
with
| Failure "int_of_string" ->
invalid_arg "Colorize().flavor_of_string: expecting integer"
let flavor_to_string = function
| White f ->
M.flavor_to_string f
| CF_in (f, c) ->
M.flavor_to_string f ^ "/" ^ string_of_int c ^ "/"
| CF_out (f, c) ->
M.flavor_to_string f ^ "//" ^ string_of_int c
| CF_io (f, c1, c2) ->
M.flavor_to_string f ^ "/" ^ string_of_int c1 ^ "/" ^ string_of_int c2
| CF_aux f ->
M.flavor_to_string f ^ "//"
let flavor_to_TeX = function
| White f ->
M.flavor_to_TeX f
| CF_in (f, c) ->
"{" ^ M.flavor_to_TeX f ^ "}_c" ^ string_of_int c
| CF_out (f, c) ->
"{" ^ M.flavor_to_TeX f ^ "}_a" ^ string_of_int c
| CF_io (f, c1, c2) ->
"{" ^ M.flavor_to_TeX f ^ "}_c" ^ string_of_int c1 ^ string_of_int c2
| CF_aux f ->
"{" ^ M.flavor_to_TeX f ^ "}_0"
let flavor_symbol = function
| White f ->
M.flavor_symbol f
| CF_in (f, c) ->
M.flavor_symbol f ^ "_" ^ string_of_int c ^ "_"
| CF_out (f, c) ->
M.flavor_symbol f ^ "__" ^ string_of_int c
| CF_io (f, c1, c2) ->
M.flavor_symbol f ^ "_" ^ string_of_int c1 ^ "_" ^ string_of_int c2
| CF_aux f ->
M.flavor_symbol f ^ "__"
let gauge_symbol = M.gauge_symbol
(* Masses and widths must not depend on the colors anyway! *)
let mass_symbol = pullback M.mass_symbol
let width_symbol = pullback M.width_symbol
let constant_symbol = M.constant_symbol
(* \thocwmodulesubsection{Vertices} *)
(* \thocwmodulesubsection{Auxiliary functions} *)
let mult_vertex3 x = function
| FBF (c, fb, coup, f) ->
FBF ((x * c), fb, coup, f)
| PBP (c, fb, coup, f) ->
PBP ((x * c), fb, coup, f)
| BBB (c, fb, coup, f) ->
BBB ((x * c), fb, coup, f)
| GBG (c, fb, coup, f) ->
GBG ((x * c), fb, coup, f)
| Gauge_Gauge_Gauge c ->
Gauge_Gauge_Gauge (x * c)
| Aux_Gauge_Gauge c ->
Aux_Gauge_Gauge (x * c)
| Scalar_Vector_Vector c ->
Scalar_Vector_Vector (x * c)
| Aux_Vector_Vector c ->
Aux_Vector_Vector (x * c)
| Aux_Scalar_Vector c ->
Aux_Scalar_Vector (x * c)
| Scalar_Scalar_Scalar c ->
Scalar_Scalar_Scalar (x * c)
| Aux_Scalar_Scalar c ->
Aux_Scalar_Scalar (x * c)
| Vector_Scalar_Scalar c ->
Vector_Scalar_Scalar (x * c)
| Graviton_Scalar_Scalar c ->
Graviton_Scalar_Scalar (x * c)
| Graviton_Vector_Vector c ->
Graviton_Vector_Vector (x * c)
| Graviton_Spinor_Spinor c ->
Graviton_Spinor_Spinor (x * c)
| Dim4_Vector_Vector_Vector_T c ->
Dim4_Vector_Vector_Vector_T (x * c)
| Dim4_Vector_Vector_Vector_L c ->
Dim4_Vector_Vector_Vector_L (x * c)
| Dim4_Vector_Vector_Vector_T5 c ->
Dim4_Vector_Vector_Vector_T5 (x * c)
| Dim4_Vector_Vector_Vector_L5 c ->
Dim4_Vector_Vector_Vector_L5 (x * c)
| Dim6_Gauge_Gauge_Gauge c ->
Dim6_Gauge_Gauge_Gauge (x * c)
| Dim6_Gauge_Gauge_Gauge_5 c ->
Dim6_Gauge_Gauge_Gauge_5 (x * c)
| Aux_DScalar_DScalar c ->
Aux_DScalar_DScalar (x * c)
| Aux_Vector_DScalar c ->
Aux_Vector_DScalar (x * c)
| Dim5_Scalar_Gauge2 c ->
Dim5_Scalar_Gauge2 (x * c)
| Dim5_Scalar_Gauge2_Skew c ->
Dim5_Scalar_Gauge2_Skew (x * c)
| Dim5_Scalar_Vector_Vector_T c ->
Dim5_Scalar_Vector_Vector_T (x * c)
| Dim5_Scalar_Vector_Vector_U c ->
Dim5_Scalar_Vector_Vector_U (x * c)
+ | Dim5_Scalar_Vector_Vector_TU c ->
+ Dim5_Scalar_Vector_Vector_TU (x * c)
| Dim6_Vector_Vector_Vector_T c ->
Dim6_Vector_Vector_Vector_T (x * c)
| Tensor_2_Vector_Vector c ->
Tensor_2_Vector_Vector (x * c)
| Dim5_Tensor_2_Vector_Vector_1 c ->
Dim5_Tensor_2_Vector_Vector_1 (x * c)
| Dim5_Tensor_2_Vector_Vector_2 c ->
Dim5_Tensor_2_Vector_Vector_2 (x * c)
| Dim7_Tensor_2_Vector_Vector_T c ->
Dim7_Tensor_2_Vector_Vector_T (x * c)
let mult_vertex4 x = function
| Scalar4 c ->
Scalar4 (x * c)
| Scalar2_Vector2 c ->
Scalar2_Vector2 (x * c)
| Vector4 ic4_list ->
Vector4 (List.map (fun (c, icl) -> (x * c, icl)) ic4_list)
| DScalar4 ic4_list ->
DScalar4 (List.map (fun (c, icl) -> (x * c, icl)) ic4_list)
| DScalar2_Vector2 ic4_list ->
DScalar2_Vector2 (List.map (fun (c, icl) -> (x * c, icl)) ic4_list)
| GBBG (c, fb, b2, f) ->
GBBG ((x * c), fb, b2, f)
| Vector4_K_Matrix_tho (c, ic4_list) ->
Vector4_K_Matrix_tho ((x * c), ic4_list)
| Vector4_K_Matrix_jr (c, ch2_list) ->
Vector4_K_Matrix_jr ((x * c), ch2_list)
let mult_vertexn x = function
| foo -> ignore (incomplete "mult_vertexn"); foo
let mult_vertex x = function
| V3 (v, fuse, c) -> V3 (mult_vertex3 x v, fuse, c)
| V4 (v, fuse, c) -> V4 (mult_vertex4 x v, fuse, c)
| Vn (v, fuse, c) -> Vn (mult_vertexn x v, fuse, c)
(* Below, we will need to permute Lorentz structures. The following
permutes the three possible contractions of four vectors. We permute
the first three indices, as they correspond to the particles entering
the fusion. *)
type permutation4 =
| P123 | P231 | P312
| P213 | P321 | P132
let permute_contract4 = function
| P123 ->
begin function
| C_12_34 -> C_12_34
| C_13_42 -> C_13_42
| C_14_23 -> C_14_23
end
| P231 ->
begin function
| C_12_34 -> C_14_23
| C_13_42 -> C_12_34
| C_14_23 -> C_13_42
end
| P312 ->
begin function
| C_12_34 -> C_13_42
| C_13_42 -> C_14_23
| C_14_23 -> C_12_34
end
| P213 ->
begin function
| C_12_34 -> C_12_34
| C_13_42 -> C_14_23
| C_14_23 -> C_13_42
end
| P321 ->
begin function
| C_12_34 -> C_14_23
| C_13_42 -> C_13_42
| C_14_23 -> C_12_34
end
| P132 ->
begin function
| C_12_34 -> C_13_42
| C_13_42 -> C_12_34
| C_14_23 -> C_14_23
end
let permute_contract4_list perm ic4_list =
List.map (fun (i, c4) -> (i, permute_contract4 perm c4)) ic4_list
let permute_vertex4' perm = function
| Scalar4 c ->
Scalar4 c
| Vector4 ic4_list ->
Vector4 (permute_contract4_list perm ic4_list)
| Vector4_K_Matrix_jr (c, ic4_list) ->
Vector4_K_Matrix_jr (c, permute_contract4_list perm ic4_list)
| Scalar2_Vector2 c ->
incomplete "permute_vertex4' Scalar2_Vector2"
| DScalar4 ic4_list ->
incomplete "permute_vertex4' DScalar4"
| DScalar2_Vector2 ic4_list ->
incomplete "permute_vertex4' DScalar2_Vector2"
| GBBG (c, fb, b2, f) ->
incomplete "permute_vertex4' GBBG"
| Vector4_K_Matrix_tho (c, ch2_list) ->
incomplete "permute_vertex4' Vector4_K_Matrix_tho"
let permute_vertex4 perm = function
| V3 (v, fuse, c) -> V3 (v, fuse, c)
| V4 (v, fuse, c) -> V4 (permute_vertex4' perm v, fuse, c)
| Vn (v, fuse, c) -> Vn (v, fuse, c)
(* [vertices] are \emph{only} used by functor applications and
for indexing a cache of precomputed fusion rules, which is not
used for colorized models. *)
let vertices () =
invalid "vertices"
(* \thocwmodulesubsection{Cubic Vertices} *)
(* \begin{dubious}
The following pattern matches could eventually become quite long.
The O'Caml compiler will (hopefully) optimize them aggressively
(\url{http://pauillac.inria.fr/~maranget/papers/opat/}).
\end{dubious} *)
let colorize_fusion2 f1 f2 (f, v) =
match M.color f with
| C.Singlet ->
begin match f1, f2 with
| White _, White _ ->
[White f, v]
| CF_in (_, c1), CF_out (_, c2')
| CF_out (_, c1), CF_in (_, c2') ->
if c1 = c2' then
[White f, v]
else
[]
| CF_io (f1, c1, c1'), CF_io (f2, c2, c2') ->
if c1 = c2' && c2 = c1' then
[White f, v]
else
[]
| CF_aux f1, CF_aux f2 ->
[White f, mult_vertex (- (nc ())) v]
| CF_aux _, CF_io _ | CF_io _, CF_aux _ ->
[]
| (CF_in _ | CF_out _ | CF_io _ | CF_aux _), White _
| White _, (CF_in _ | CF_out _ | CF_io _ | CF_aux _)
| (CF_io _ | CF_aux _), (CF_in _ | CF_out _)
| (CF_in _ | CF_out _), (CF_io _ | CF_aux _)
| CF_in _, CF_in _ | CF_out _, CF_out _ ->
colored_vertex "colorize_fusion2"
end
| C.SUN nc1 ->
begin match f1, f2 with
| CF_in (_, c1), (White _ | CF_aux _)
| (White _ | CF_aux _), CF_in (_, c1) ->
if nc1 > 0 then
[CF_in (f, c1), v]
else
colored_vertex "colorize_fusion2"
| CF_out (_, c1'), (White _ | CF_aux _)
| (White _ | CF_aux _), CF_out (_, c1') ->
if nc1 < 0 then
[CF_out (f, c1'), v]
else
colored_vertex "colorize_fusion2"
| CF_in (_, c1), CF_io (_, c2, c2')
| CF_io (_, c2, c2'), CF_in (_, c1) ->
if nc1 > 0 then begin
if c1 = c2' then
[CF_in (f, c2), v]
else
[]
end else
colored_vertex "colorize_fusion2"
| CF_out (_, c1'), CF_io (_, c2, c2')
| CF_io (_, c2, c2'), CF_out (_, c1') ->
if nc1 < 0 then begin
if c1' = c2 then
[CF_out (f, c2'), v]
else
[]
end else
colored_vertex "colorize_fusion2"
| CF_in _, CF_in _ ->
if nc1 > 0 then
baryonic_vertex "colorize_fusion2"
else
colored_vertex "colorize_fusion2"
| CF_out _, CF_out _ ->
if nc1 < 0 then
baryonic_vertex "colorize_fusion2"
else
colored_vertex "colorize_fusion2"
| CF_in _, CF_out _ | CF_out _, CF_in _
| (White _ | CF_io _ | CF_aux _),
(White _ | CF_io _ | CF_aux _) ->
colored_vertex "colorize_fusion2"
end
| C.AdjSUN _ ->
begin match f1, f2 with
| White _, CF_io (_, c1, c2') | CF_io (_, c1, c2'), White _ ->
[CF_io (f, c1, c2'), v]
| White _, CF_aux _ | CF_aux _, White _ ->
[CF_aux f, mult_vertex (- (nc ())) v]
| CF_in (_, c1), CF_out (_, c2')
| CF_out (_, c2'), CF_in (_, c1) ->
if c1 <> c2' then
[CF_io (f, c1, c2'), v]
else
[CF_aux f, v]
(* In the adjoint representation
\begin{subequations}
\begin{equation}
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,24)
\fmfsurround{d1,e1,d2,e2,d3,e3}
\fmf{gluon}{v,e1}
\fmf{gluon}{v,e2}
\fmf{gluon}{v,e3}
\fmflabel{1}{e1}
\fmflabel{2}{e2}
\fmflabel{3}{e3}
\fmfdot{v}
\fmffreeze
\fmf{warrow_right}{v,e1}
\fmf{warrow_right}{v,e2}
\fmf{warrow_right}{v,e3}
\end{fmfgraph*}}} \,=
%begin{split}
g f_{a_1a_2a_3} C^{\mu_1\mu_2\mu_3} (k_1,k_2,k_3)
%end{split}
\end{equation}
with
\begin{multline}
\label{eq:C123}
C^{\mu_1\mu_2\mu_3}(k_1,k_2,k_3) = \\
( g^{\mu_1\mu_2} (k_1^{\mu_3}-k_2^{\mu_3})
+ g^{\mu_2\mu_3} (k_2^{\mu_1}-k_3^{\mu_1})
+ g^{\mu_3\mu_1} (k_3^{\mu_2}-k_1^{\mu_2}) )
\end{multline}
\end{subequations}
while in the color flow basis find from
\begin{equation}
\ii f_{a_1a_2a_3}
= \tr\left(T_{a_1}\left\lbrack T_{a_2},T_{a_3}\right\rbrack\right)
= \tr\left(T_{a_1}T_{a_2}T_{a_3}\right)
- \tr\left(T_{a_1}T_{a_3}T_{a_2}\right)
\end{equation}
the decomposition
\begin{equation}
\ii f_{a_1a_2a_3} T_{a_1}^{i_1j_1}T_{a_2}^{i_2j_2}T_{a_3}^{i_3j_3}
= \delta^{i_1j_2}\delta^{i_2j_3}\delta^{i_3j_1}
- \delta^{i_1j_3}\delta^{i_3j_2}\delta^{i_2j_1}\,.
\end{equation}
The resulting Feynman rule is
\begin{equation}
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,24)
\fmfsurround{d1,e1,d2,e2,d3,e3}
\fmf{phantom}{v,e1}
\fmf{phantom}{v,e2}
\fmf{phantom}{v,e3}
\fmflabel{1}{e1}
\fmflabel{2}{e2}
\fmflabel{3}{e3}
\fmffreeze
\fmfi{phantom_arrow}{(reverse vpath (__e1, __v) sideways -thick)}
\fmfi{phantom_arrow}{( vpath (__e2, __v) sideways -thick)}
\fmfi{phantom_arrow}{(reverse vpath (__e2, __v) sideways -thick)}
\fmfi{phantom_arrow}{( vpath (__e3, __v) sideways -thick)}
\fmfi{phantom_arrow}{(reverse vpath (__e3, __v) sideways -thick)}
\fmfi{phantom_arrow}{( vpath (__e1, __v) sideways -thick)}
\fmfi{plain}{%
(reverse vpath (__e1, __v) sideways -thick)
join ( vpath (__e2, __v) sideways -thick)}
\fmfi{plain}{%
(reverse vpath (__e2, __v) sideways -thick)
join ( vpath (__e3, __v) sideways -thick)}
\fmfi{plain}{%
(reverse vpath (__e3, __v) sideways -thick)
join ( vpath (__e1, __v) sideways -thick)}
\end{fmfgraph*}}} \,=
\ii g
\left( \delta^{i_1j_3}\delta^{i_2j_1}\delta^{i_3j_2}
- \delta^{i_1j_2}\delta^{i_2j_3}\delta^{i_3j_1} \right)
C^{\mu_1\mu_2\mu_3} (k_1,k_2,k_3)
\end{equation} *)
(* \begin{dubious}
We have to generalize this for cases of three particles
in the adjoint that are not all gluons (gluinos, scalar octets):
\begin{itemize}
\item scalar-scalar-scalar
\item scalar-scalar-vector
\item scalar-vector-vector
\item scalar-fermion-fermion
\item vector-fermion-fermion
\end{itemize}
\end{dubious} *)
(* \begin{dubious}
We could use a better understanding of the signs for the
gaugino-gaugino-gaugeboson couplings!!!
\end{dubious} *)
| CF_io (f1, c1, c1'), CF_io (f2, c2, c2') ->
let sign =
begin match v with
| V3 (Gauge_Gauge_Gauge _, _, _)
| V3 (Aux_Gauge_Gauge _, _, _) -> 1
| V3 (FBF (_, _, _, _), fuse2, _) ->
begin match fuse2 with
| F12 -> 1 (* works, but needs theoretical underpinning *)
| F21 -> -1 (* dto. *)
| F31 -> 1 (* dto. *)
| F32 -> -1 (* transposition of [F12] (no testcase) *)
| F23 -> 1 (* transposition of [F21] (no testcase) *)
| F13 -> -1 (* transposition of [F12] (no testcase) *)
end
| V3 _ -> incomplete "colorize_fusion2 (V3 _)"
| V4 _ -> impossible "colorize_fusion2 (V4 _)"
| Vn _ -> impossible "colorize_fusion2 (Vn _)"
end in
if c1' = c2 then
[CF_io (f, c1, c2'), mult_vertex (-sign) v]
else if c2' = c1 then
[CF_io (f, c2, c1'), mult_vertex ( sign) v]
else
[]
| CF_aux _ , CF_io _
| CF_io _ , CF_aux _
| CF_aux _ , CF_aux _ ->
[]
| White _, White _
| (White _ | CF_io _ | CF_aux _), (CF_in _ | CF_out _)
| (CF_in _ | CF_out _), (White _ | CF_io _ | CF_aux _)
| CF_in _, CF_in _ | CF_out _, CF_out _ ->
colored_vertex "colorize_fusion2"
end
(* \thocwmodulesubsection{Quartic Vertices} *)
let colorize_fusion3 f1 f2 f3 (f, v) =
match M.color f with
| C.Singlet ->
begin match f1, f2, f3 with
| White _, White _, White _ ->
[White f, v]
| (White _ | CF_aux _), CF_in (_, c1), CF_out (_, c2')
| (White _ | CF_aux _), CF_out (_, c1), CF_in (_, c2')
| CF_in (_, c1), (White _ | CF_aux _), CF_out (_, c2')
| CF_out (_, c1), (White _ | CF_aux _), CF_in (_, c2')
| CF_in (_, c1), CF_out (_, c2'), (White _ | CF_aux _)
| CF_out (_, c1), CF_in (_, c2'), (White _ | CF_aux _) ->
if c1 = c2' then
[White f, v]
else
[]
| White _, CF_io (_, c1, c1'), CF_io (_, c2, c2')
| CF_io (_, c1, c1'), White _, CF_io (_, c2, c2')
| CF_io (_, c1, c1'), CF_io (_, c2, c2'), White _ ->
if c1 = c2' && c2 = c1' then
[White f, v]
else
[]
| White _, CF_aux _, CF_aux _
| CF_aux _, White _, CF_aux _
| CF_aux _, CF_aux _, White _ ->
[White f, mult_vertex (- (nc ())) v]
| White _, CF_io _, CF_aux _
| White _, CF_aux _, CF_io _
| CF_io _, White _, CF_aux _
| CF_aux _, White _, CF_io _
| CF_io _, CF_aux _, White _
| CF_aux _, CF_io _, White _ ->
[]
| CF_io (_, c1, c1'), CF_in (_, c2), CF_out (_, c3')
| CF_io (_, c1, c1'), CF_out (_, c3'), CF_in (_, c2)
| CF_in (_, c2), CF_io (_, c1, c1'), CF_out (_, c3')
| CF_out (_, c3'), CF_io (_, c1, c1'), CF_in (_, c2)
| CF_in (_, c2), CF_out (_, c3'), CF_io (_, c1, c1')
| CF_out (_, c3'), CF_in (_, c2), CF_io (_, c1, c1') ->
if c1 = c3' && c1' = c2 then
[White f, v]
else
[]
| CF_io (_, c1, c1'), CF_io (_, c2, c2'), CF_io (_, c3, c3') ->
if c1' = c2 && c2' = c3 && c3' = c1 then
[White f, mult_vertex (-1) v]
else if c1' = c3 && c2' = c1 && c3' = c2 then
[White f, mult_vertex ( 1) v]
else
[]
| CF_io _, CF_io _, CF_aux _
| CF_io _, CF_aux _, CF_io _
| CF_aux _, CF_io _, CF_io _
| CF_io _, CF_aux _, CF_aux _
| CF_aux _, CF_io _, CF_aux _
| CF_aux _, CF_aux _, CF_io _
| CF_aux _, CF_aux _, CF_aux _ ->
[]
| CF_in _, CF_in _, CF_in _
| CF_out _, CF_out _, CF_out _ ->
baryonic_vertex "colorize_fusion3"
| CF_in _, CF_in _, CF_out _
| CF_in _, CF_out _, CF_in _
| CF_out _, CF_in _, CF_in _
| CF_in _, CF_out _, CF_out _
| CF_out _, CF_in _, CF_out _
| CF_out _, CF_out _, CF_in _
| White _, White _, (CF_io _ | CF_aux _)
| White _, (CF_io _ | CF_aux _), White _
| (CF_io _ | CF_aux _), White _, White _
| (White _ | CF_io _ | CF_aux _), CF_in _, CF_in _
| CF_in _, (White _ | CF_io _ | CF_aux _), CF_in _
| CF_in _, CF_in _, (White _ | CF_io _ | CF_aux _)
| (White _ | CF_io _ | CF_aux _), CF_out _, CF_out _
| CF_out _, (White _ | CF_io _ | CF_aux _), CF_out _
| CF_out _, CF_out _, (White _ | CF_io _ | CF_aux _)
| (CF_in _ | CF_out _),
(White _ | CF_io _ | CF_aux _),
(White _ | CF_io _ | CF_aux _)
| (White _ | CF_io _ | CF_aux _),
(CF_in _ | CF_out _),
(White _ | CF_io _ | CF_aux _)
| (White _ | CF_io _ | CF_aux _),
(White _ | CF_io _ | CF_aux _),
(CF_in _ | CF_out _) ->
colored_vertex "colorize_fusion3"
end
| C.SUN nc1 ->
begin match f1, f2, f3 with
| CF_in (_, c1), CF_io (_, c2, c2'), CF_io (_, c3, c3')
| CF_io (_, c2, c2'), CF_in (_, c1), CF_io (_, c3, c3')
| CF_io (_, c2, c2'), CF_io (_, c3, c3'), CF_in (_, c1) ->
if nc1 > 0 then
if c1 = c2' && c2 = c3' then
[CF_in (f, c3), v]
else if c1 = c3' && c3 = c2' then
[CF_in (f, c2), v]
else
[]
else
colored_vertex "colorize_fusion3"
| CF_out (_, c1'), CF_io (_, c2, c2'), CF_io (_, c3, c3')
| CF_io (_, c2, c2'), CF_out (_, c1'), CF_io (_, c3, c3')
| CF_io (_, c2, c2'), CF_io (_, c3, c3'), CF_out (_, c1') ->
if nc1 < 0 then
if c1' = c2 && c2' = c3 then
[CF_out (f, c3'), v]
else if c1' = c3 && c3' = c2 then
[CF_out (f, c2'), v]
else
[]
else
colored_vertex "colorize_fusion3"
| CF_aux _, CF_in (_, c1), CF_io (_, c2, c2')
| CF_aux _, CF_io (_, c2, c2'), CF_in (_, c1)
| CF_in (_, c1), CF_aux _, CF_io (_, c2, c2')
| CF_io (_, c2, c2'), CF_aux _, CF_in (_, c1)
| CF_in (_, c1), CF_io (_, c2, c2'), CF_aux _
| CF_io (_, c2, c2'), CF_in (_, c1), CF_aux _ ->
if nc1 > 0 then
if c1 = c2' then
[CF_in (f, c2), mult_vertex ( 2) v]
else
[]
else
colored_vertex "colorize_fusion3"
| CF_aux _, CF_out (_, c1'), CF_io (_, c2, c2')
| CF_aux _, CF_io (_, c2, c2'), CF_out (_, c1')
| CF_out (_, c1'), CF_aux _, CF_io (_, c2, c2')
| CF_io (_, c2, c2'), CF_aux _, CF_out (_, c1')
| CF_out (_, c1'), CF_io (_, c2, c2'), CF_aux _
| CF_io (_, c2, c2'), CF_out (_, c1'), CF_aux _ ->
if nc1 < 0 then
if c1' = c2 then
[CF_out (f, c2'), mult_vertex ( 2) v]
else
[]
else
colored_vertex "colorize_fusion3"
| White _, CF_in (_, c1), CF_io (_, c2, c2')
| White _, CF_io (_, c2, c2'), CF_in (_, c1)
| CF_in (_, c1), White _, CF_io (_, c2, c2')
| CF_io (_, c2, c2'), White _, CF_in (_, c1)
| CF_in (_, c1), CF_io (_, c2, c2'), White _
| CF_io (_, c2, c2'), CF_in (_, c1), White _ ->
if nc1 > 0 then
if c1 = c2' then
[CF_in (f, c2), v]
else
[]
else
colored_vertex "colorize_fusion3"
| White _, CF_out (_, c1'), CF_io (_, c2, c2')
| White _, CF_io (_, c2, c2'), CF_out (_, c1')
| CF_out (_, c1'), White _, CF_io (_, c2, c2')
| CF_io (_, c2, c2'), White _, CF_out (_, c1')
| CF_out (_, c1'), CF_io (_, c2, c2'), White _
| CF_io (_, c2, c2'), CF_out (_, c1'), White _ ->
if nc1 < 0 then
if c2 = c1' then
[CF_out (f, c2'), v]
else
[]
else
colored_vertex "colorize_fusion3"
| CF_in (_, c1), CF_aux _, CF_aux _
| CF_aux _, CF_in (_, c1), CF_aux _
| CF_aux _, CF_aux _, CF_in (_, c1) ->
if nc1 > 0 then
[CF_in (f, c1), mult_vertex ( 2) v]
else
colored_vertex "colorize_fusion3"
| CF_in (_, c1), CF_aux _, White _
| CF_in (_, c1), White _, CF_aux _
| CF_in (_, c1), White _, White _
| CF_aux _, CF_in (_, c1), White _
| White _, CF_in (_, c1), CF_aux _
| White _, CF_in (_, c1), White _
| CF_aux _, White _, CF_in (_, c1)
| White _, CF_aux _, CF_in (_, c1)
| White _, White _, CF_in (_, c1) ->
if nc1 > 0 then
[CF_in (f, c1), v]
else
colored_vertex "colorize_fusion3"
| CF_out (_, c1'), CF_aux _, CF_aux _
| CF_aux _, CF_out (_, c1'), CF_aux _
| CF_aux _, CF_aux _, CF_out (_, c1') ->
if nc1 < 0 then
[CF_out (f, c1'), mult_vertex ( 2) v]
else
colored_vertex "colorize_fusion3"
| CF_out (_, c1'), CF_aux _, White _
| CF_out (_, c1'), White _, CF_aux _
| CF_out (_, c1'), White _, White _
| CF_aux _, CF_out (_, c1'), White _
| White _, CF_out (_, c1'), CF_aux _
| White _, CF_out (_, c1'), White _
| CF_aux _, White _, CF_out (_, c1')
| White _, CF_aux _, CF_out (_, c1')
| White _, White _, CF_out (_, c1') ->
if nc1 < 0 then
[CF_out (f, c1'), v]
else
colored_vertex "colorize_fusion3"
| CF_in _, CF_in _, CF_out _
| CF_in _, CF_out _, CF_in _
| CF_out _, CF_in _, CF_in _ ->
if nc1 > 0 then
color_flow_ambiguous "colorize_fusion3"
else
colored_vertex "colorize_fusion3"
| CF_in _, CF_out _, CF_out _
| CF_out _, CF_in _, CF_out _
| CF_out _, CF_out _, CF_in _ ->
if nc1 < 0 then
color_flow_ambiguous "colorize_fusion3"
else
colored_vertex "colorize_fusion3"
| CF_in _, CF_in _, CF_in _
| CF_out _, CF_out _, CF_out _
| (White _ | CF_io _ | CF_aux _),
(White _ | CF_io _ | CF_aux _),
(White _ | CF_io _ | CF_aux _)
| (CF_in _ | CF_out _),
(CF_in _ | CF_out _),
(White _ | CF_io _ | CF_aux _)
| (CF_in _ | CF_out _),
(White _ | CF_io _ | CF_aux _),
(CF_in _ | CF_out _)
| (White _ | CF_io _ | CF_aux _),
(CF_in _ | CF_out _),
(CF_in _ | CF_out _) ->
colored_vertex "colorize_fusion3"
end
| C.AdjSUN nc ->
begin match f1, f2, f3 with
| CF_in (_, c1), CF_out (_, c1'), White _
| CF_out (_, c1'), CF_in (_, c1), White _
| CF_in (_, c1), White _, CF_out (_, c1')
| CF_out (_, c1'), White _, CF_in (_, c1)
| White _, CF_in (_, c1), CF_out (_, c1')
| White _, CF_out (_, c1'), CF_in (_, c1) ->
if c1 <> c1' then
[CF_io (f, c1, c1'), v]
else
[CF_aux f, v]
| CF_in (_, c1), CF_out (_, c1'), CF_aux _
| CF_out (_, c1'), CF_in (_, c1), CF_aux _
| CF_in (_, c1), CF_aux _, CF_out (_, c1')
| CF_out (_, c1'), CF_aux _, CF_in (_, c1)
| CF_aux _, CF_in (_, c1), CF_out (_, c1')
| CF_aux _, CF_out (_, c1'), CF_in (_, c1) ->
if c1 <> c1' then
[CF_io (f, c1, c1'), mult_vertex ( 2) v]
else
[CF_aux f, mult_vertex ( 2) v]
| CF_in (_, c1), CF_out (_, c1'), CF_io (_, c2, c2')
| CF_out (_, c1'), CF_in (_, c1), CF_io (_, c2, c2')
| CF_in (_, c1), CF_io (_, c2, c2'), CF_out (_, c1')
| CF_out (_, c1'), CF_io (_, c2, c2'), CF_in (_, c1)
| CF_io (_, c2, c2'), CF_in (_, c1), CF_out (_, c1')
| CF_io (_, c2, c2'), CF_out (_, c1'), CF_in (_, c1) ->
if c1 = c2' && c2 = c1' then
[CF_aux f, mult_vertex ( 2) v]
else if c1 = c2' then
[CF_io (f, c2, c1'), v]
else if c2 = c1' then
[CF_io (f, c1, c2'), v]
else
[]
(* \begin{equation}
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,24)
\fmfsurround{d1,e1,d2,e2,d3,e3,d4,e4}
\fmf{gluon}{v,e1}
\fmf{gluon}{v,e2}
\fmf{gluon}{v,e3}
\fmf{gluon}{v,e4}
\fmflabel{1}{e1}
\fmflabel{2}{e2}
\fmflabel{3}{e3}
\fmflabel{4}{e4}
\fmfdot{v}
\fmffreeze
\fmf{warrow_right}{v,e1}
\fmf{warrow_right}{v,e2}
\fmf{warrow_right}{v,e3}
\fmf{warrow_right}{v,e4}
\end{fmfgraph*}}} \,=
\begin{split}
\mbox{} - & \ii g^2 f_{a_1a_2b}f_{a_3a_4b}
(g_{\mu_1\mu_3} g_{\mu_4\mu_2} - g_{\mu_1\mu_4} g_{\mu_2\mu_3}) \\
\mbox{} - & \ii g^2 f_{a_1a_3b}f_{a_4a_2b}
(g_{\mu_1\mu_4} g_{\mu_2\mu_3} - g_{\mu_1\mu_2} g_{\mu_3\mu_4}) \\
\mbox{} - & \ii g^2 f_{a_1a_4b}f_{a_2a_3b}
(g_{\mu_1\mu_2} g_{\mu_3\mu_4} - g_{\mu_1\mu_3} g_{\mu_4\mu_2})
\end{split}
\end{equation} *)
(* Using
\begin{equation}
\mathcal{P}_4 = \left\{\{1,2,3,4\},\{1,3,4,2\},\{1,4,2,3\},
\{1,2,4,3\},\{1,4,3,2\},\{1,3,2,4\}\right\}
\end{equation}
as the set of permutations of~$\{1,2,3,4\}$ with the cyclic permutations
factored out, we have:
\begin{equation}
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,24)
\fmfsurround{d1,e1,d2,e2,d3,e3,d4,e4}
\fmf{phantom}{v,e1}
\fmf{phantom}{v,e2}
\fmf{phantom}{v,e3}
\fmf{phantom}{v,e4}
\fmflabel{1}{e1}
\fmflabel{2}{e2}
\fmflabel{3}{e3}
\fmflabel{4}{e4}
\fmffreeze
\fmfi{phantom_arrow}{(reverse vpath (__e1, __v) sideways -thick)}
\fmfi{phantom_arrow}{( vpath (__e2, __v) sideways -thick)}
\fmfi{phantom_arrow}{(reverse vpath (__e2, __v) sideways -thick)}
\fmfi{phantom_arrow}{( vpath (__e3, __v) sideways -thick)}
\fmfi{phantom_arrow}{(reverse vpath (__e3, __v) sideways -thick)}
\fmfi{phantom_arrow}{( vpath (__e4, __v) sideways -thick)}
\fmfi{phantom_arrow}{(reverse vpath (__e4, __v) sideways -thick)}
\fmfi{phantom_arrow}{( vpath (__e1, __v) sideways -thick)}
\fmfi{plain}{%
(reverse vpath (__e1, __v) sideways -thick)
join ( vpath (__e2, __v) sideways -thick)}
\fmfi{plain}{%
(reverse vpath (__e2, __v) sideways -thick)
join ( vpath (__e3, __v) sideways -thick)}
\fmfi{plain}{%
(reverse vpath (__e3, __v) sideways -thick)
join ( vpath (__e4, __v) sideways -thick)}
\fmfi{plain}{%
(reverse vpath (__e4, __v) sideways -thick)
join ( vpath (__e1, __v) sideways -thick)}
\end{fmfgraph*}}} \,=
\begin{aligned}
\ii g^2 \sum_{\{\alpha_k\}_{k=1,2,3,4}\in\mathcal{P}_4}
\delta^{i_{\alpha_1}j_{\alpha_2}}\delta^{i_{\alpha_2}j_{\alpha_3}}
\delta^{i_{\alpha_3}j_{\alpha_4}}\delta^{i_{\alpha_4}j_{\alpha_1}}\qquad\qquad\\
\left( 2g_{\mu_{\alpha_1}\mu_{\alpha_3}} g_{\mu_{\alpha_4}\mu_{\alpha_2}}
- g_{\mu_{\alpha_1}\mu_{\alpha_4}} g_{\mu_{\alpha_2}\mu_{\alpha_3}}
- g_{\mu_{\alpha_1}\mu_{\alpha_2}} g_{\mu_{\alpha_3}\mu_{\alpha_4}}\right)
\end{aligned}
\end{equation} *)
(* The different color connections correspond to permutations of the
particles entering the fusion and have to be matched by a corresponding
permutation of the Lorentz structure: *)
(* \begin{dubious}
We have to generalize this for cases of four particles
in the adjoint that are not all gluons:
\begin{itemize}
\item scalar-scalar-scalar-scalar
\item scalar-scalar-vector-vector
\end{itemize}
and even ones including fermions (gluinos) if higher dimensional
operators are involved.
\end{dubious} *)
| CF_io (_, c1, c1'), CF_io (_, c2, c2'), CF_io (_, c3, c3') ->
if c1' = c2 && c2' = c3 then
[CF_io (f, c1, c3'), permute_vertex4 P123 v]
else if c1' = c3 && c3' = c2 then
[CF_io (f, c1, c2'), permute_vertex4 P132 v]
else if c2' = c3 && c3' = c1 then
[CF_io (f, c2, c1'), permute_vertex4 P231 v]
else if c2' = c1 && c1' = c3 then
[CF_io (f, c2, c3'), permute_vertex4 P213 v]
else if c3' = c1 && c1' = c2 then
[CF_io (f, c3, c2'), permute_vertex4 P312 v]
else if c3' = c2 && c2' = c1 then
[CF_io (f, c3, c1'), permute_vertex4 P321 v]
else
[]
| CF_io _, CF_io _, CF_aux _
| CF_io _, CF_aux _, CF_io _
| CF_aux _, CF_io _, CF_io _
| CF_io _, CF_aux _, CF_aux _
| CF_aux _, CF_aux _, CF_io _
| CF_aux _, CF_io _, CF_aux _
| CF_aux _, CF_aux _, CF_aux _ ->
[]
| CF_io (_, c1, c1'), CF_io (_, c2, c2'), White _
| CF_io (_, c1, c1'), White _, CF_io (_, c2, c2')
| White _, CF_io (_, c1, c1'), CF_io (_, c2, c2') ->
if c1' = c2 then
[CF_io (f, c1, c2'), mult_vertex (-1) v]
else if c2' = c1 then
[CF_io (f, c2, c1'), mult_vertex ( 1) v]
else
[]
| CF_io (_, c1, c1'), CF_aux _, White _
| CF_aux _, CF_io (_, c1, c1'), White _
| CF_io (_, c1, c1'), White _, CF_aux _
| CF_aux _, White _, CF_io (_, c1, c1')
| White _, CF_io (_, c1, c1'), CF_aux _
| White _, CF_aux _, CF_io (_, c1, c1') ->
[]
| CF_aux _, CF_aux _, White _
| CF_aux _, White _, CF_aux _
| White _, CF_aux _, CF_aux _ ->
[]
| White _, White _, CF_io (_, c1, c1')
| White _, CF_io (_, c1, c1'), White _
| CF_io (_, c1, c1'), White _, White _ ->
[CF_io (f, c1, c1'), v]
| White _, White _, CF_aux _
| White _, CF_aux _, White _
| CF_aux _, White _, White _ ->
[]
| White _, White _, White _
| (White _ | CF_io _ | CF_aux _),
(White _ | CF_io _ | CF_aux _),
(CF_in _ | CF_out _)
| (White _ | CF_io _ | CF_aux _),
(CF_in _ | CF_out _),
(White _ | CF_io _ | CF_aux _)
| (CF_in _ | CF_out _),
(White _ | CF_io _ | CF_aux _),
(White _ | CF_io _ | CF_aux _)
| CF_in _, CF_in _, (White _ | CF_io _ | CF_aux _)
| CF_in _, (White _ | CF_io _ | CF_aux _), CF_in _
| (White _ | CF_io _ | CF_aux _), CF_in _, CF_in _
| CF_out _, CF_out _, (White _ | CF_io _ | CF_aux _)
| CF_out _, (White _ | CF_io _ | CF_aux _), CF_out _
| (White _ | CF_io _ | CF_aux _), CF_out _, CF_out _
| (CF_in _ | CF_out _),
(CF_in _ | CF_out _),
(CF_in _ | CF_out _) ->
colored_vertex "colorize_fusion3"
end
(* \thocwmodulesubsection{Quintic and Higher Vertices} *)
let is_white = function
| White _ -> true
| _ -> false
let colorize_fusionn flist (f, v) =
let incomplete_match () =
incomplete
("colorize_fusionn { " ^
String.concat ", " (List.map flavor_to_string flist) ^
" } -> " ^ M.flavor_to_string f) in
match M.color f with
| C.Singlet ->
if List.for_all is_white flist then
[White f, v]
else
incomplete_match ()
| C.SUN _ ->
if List.for_all is_white flist then
colored_vertex "colorize_fusionn"
else
incomplete_match ()
| C.AdjSUN _ ->
if List.for_all is_white flist then
colored_vertex "colorize_fusionn"
else
incomplete_match ()
let fuse2 f1 f2 =
ThoList.flatmap
(colorize_fusion2 f1 f2)
(M.fuse2 (flavor_sans_color f1) (flavor_sans_color f2))
let fuse3 f1 f2 f3 =
ThoList.flatmap
(colorize_fusion3 f1 f2 f3)
(M.fuse3 (flavor_sans_color f1) (flavor_sans_color f2) (flavor_sans_color f3))
let fuse_list flist =
ThoList.flatmap
(colorize_fusionn flist)
(M.fuse (List.map flavor_sans_color flist))
let fuse = function
| [] | [_] -> invalid_arg "Colorize.It().fuse"
| [f1; f2] -> fuse2 f1 f2
| [f1; f2; f3] -> fuse3 f1 f2 f3
| flist -> fuse_list flist
let max_degree = M.max_degree
(* \thocwmodulesubsection{Adding Color to External Particles} *)
let count_color_strings f_list =
let rec count_color_strings' n_in n_out n_glue = function
| f :: rest ->
begin match M.color f with
| C.Singlet -> count_color_strings' n_in n_out n_glue rest
| C.SUN nc ->
if nc > 0 then
count_color_strings' (succ n_in) n_out n_glue rest
else if nc < 0 then
count_color_strings' n_in (succ n_out) n_glue rest
else
su0 "count_color_strings"
| C.AdjSUN _ ->
count_color_strings' (succ n_in) (succ n_out) (succ n_glue) rest
end
| [] -> (n_in, n_out, n_glue)
in
count_color_strings' 0 0 0 f_list
let external_color_flows f_list =
let n_in, n_out, n_glue = count_color_strings f_list in
if n_in <> n_out then
[]
else
let color_strings = ThoList.range 1 n_in in
List.map
(fun permutation -> (color_strings, permutation))
(Combinatorics.permute color_strings)
(* If there are only adjoints \emph{and} there are no couplings of
adjoints to singlets, we can ignore the $\mathrm{U}(1)$-ghosts. *)
let pure_adjoints f_list =
List.for_all (fun f -> match M.color f with C.AdjSUN _ -> true | _ -> false) f_list
let two_adjoints_couple_to_singlets () =
let vertices3, vertices4, verticesn = M.vertices () in
List.exists (fun ((f1, f2, f3), _, _) ->
match M.color f1, M.color f2, M.color f3 with
| C.AdjSUN _, C.AdjSUN _, C.Singlet
| C.AdjSUN _, C.Singlet, C.AdjSUN _
| C.Singlet, C.AdjSUN _, C.AdjSUN _ -> true
| _ -> false) vertices3 ||
List.exists (fun ((f1, f2, f3, f4), _, _) ->
match M.color f1, M.color f2, M.color f3, M.color f4 with
| C.AdjSUN _, C.AdjSUN _, C.Singlet, C.Singlet
| C.AdjSUN _, C.Singlet, C.AdjSUN _, C.Singlet
| C.Singlet, C.AdjSUN _, C.AdjSUN _, C.Singlet
| C.AdjSUN _, C.Singlet, C.Singlet, C.AdjSUN _
| C.Singlet, C.AdjSUN _, C.Singlet, C.AdjSUN _
| C.Singlet, C.Singlet, C.AdjSUN _, C.AdjSUN _ -> true
| _ -> false) vertices4 ||
List.exists (fun (flist, _, g) -> true) verticesn
let external_ghosts f_list =
if pure_adjoints f_list then
two_adjoints_couple_to_singlets ()
else
true
(* We use [List.hd] and [List.tl] instead of pattern matching, because we
consume [ecf_in] and [ecf_out] at a different pace. *)
let tail_opt = function
| [] -> []
| _ :: tail -> tail
let head_req = function
| [] ->
invalid_arg "Colorize.It().colorize_crossed_amplitude1: insufficient flows"
| x :: _ -> x
let rec colorize_crossed_amplitude1 ghosts acc f_list (ecf_in, ecf_out) =
match f_list, ecf_in, ecf_out with
| [], [], [] -> [List.rev acc]
| [], _, _ ->
invalid_arg "Colorize.It().colorize_crossed_amplitude1: leftover flows"
| f :: rest, _, _ ->
begin match M.color f with
| C.Singlet ->
colorize_crossed_amplitude1 ghosts
(White f :: acc)
rest (ecf_in, ecf_out)
| C.SUN nc ->
if nc > 0 then
colorize_crossed_amplitude1 ghosts
(CF_in (f, head_req ecf_in) :: acc)
rest (tail_opt ecf_in, ecf_out)
else if nc < 0 then
colorize_crossed_amplitude1 ghosts
(CF_out (f, head_req ecf_out) :: acc)
rest (ecf_in, tail_opt ecf_out)
else
su0 "colorize_flavor"
| C.AdjSUN _ ->
let ecf_in' = head_req ecf_in
and ecf_out' = head_req ecf_out in
if ecf_in' = ecf_out' then begin
if ghosts then
colorize_crossed_amplitude1 ghosts
(CF_aux f :: acc)
rest (tail_opt ecf_in, tail_opt ecf_out)
else
[]
end else
colorize_crossed_amplitude1 ghosts
(CF_io (f, ecf_in', ecf_out') :: acc)
rest (tail_opt ecf_in, tail_opt ecf_out)
end
let colorize_crossed_amplitude1 ghosts f_list (ecf_in, ecf_out) =
colorize_crossed_amplitude1 ghosts [] f_list (ecf_in, ecf_out)
let colorize_crossed_amplitude f_list =
ThoList.flatmap
(colorize_crossed_amplitude1 (external_ghosts f_list) f_list)
(external_color_flows f_list)
let cross_uncolored p_in p_out =
(List.map M.conjugate p_in) @ p_out
let uncross_colored n_in p_lists_colorized =
let p_in_out_colorized = List.map (ThoList.splitn n_in) p_lists_colorized in
List.map
(fun (p_in_colored, p_out_colored) ->
(List.map conjugate p_in_colored, p_out_colored))
p_in_out_colorized
let amplitude p_in p_out =
uncross_colored
(List.length p_in)
(colorize_crossed_amplitude (cross_uncolored p_in p_out))
(* The $-$-sign in the second component is redundant, but a Whizard convention. *)
let indices = function
| White _ -> Color.Flow.of_list [0; 0]
| CF_in (_, c) -> Color.Flow.of_list [c; 0]
| CF_out (_, c) -> Color.Flow.of_list [0; -c]
| CF_io (_, c1, c2) -> Color.Flow.of_list [c1; -c2]
| CF_aux f -> Color.Flow.ghost ()
let flow p_in p_out =
(List.map indices p_in, List.map indices p_out)
end
(* \thocwmodulesection{Colorizing a Monochrome Gauge Model} *)
module Gauge (M : Model.Gauge) =
struct
let rcs = RCS.rename rcs_file "Colorize.Gauge()"
[ "Colorizing Monochrome Gauge Models"]
module CM = It(M)
type flavor = CM.flavor
type flavor_sans_color = CM.flavor_sans_color
type gauge = CM.gauge
type constant = CM.constant
module Ch = CM.Ch
let charges = CM.charges
let flavor_sans_color = CM.flavor_sans_color
let color = CM.color
let pdg = CM.pdg
let lorentz = CM.lorentz
let propagator = CM.propagator
let width = CM.width
let conjugate = CM.conjugate
let conjugate_sans_color = CM.conjugate_sans_color
let fermion = CM.fermion
let max_degree = CM.max_degree
let vertices = CM.vertices
let fuse2 = CM.fuse2
let fuse3 = CM.fuse3
let fuse = CM.fuse
let flavors = CM.flavors
let nc = CM.nc
let external_flavors = CM.external_flavors
let goldstone = CM.goldstone
let parameters = CM.parameters
let flavor_of_string = CM.flavor_of_string
let flavor_to_string = CM.flavor_to_string
let flavor_to_TeX = CM.flavor_to_TeX
let flavor_symbol = CM.flavor_symbol
let gauge_symbol = CM.gauge_symbol
let mass_symbol = CM.mass_symbol
let width_symbol = CM.width_symbol
let constant_symbol = CM.constant_symbol
let options = CM.options
let incomplete s =
failwith ("Colorize.Gauge()." ^ s ^ " not done yet!")
type matter_field = M.matter_field
type gauge_boson = M.gauge_boson
type other = M.other
type field =
| Matter of matter_field
| Gauge of gauge_boson
| Other of other
let field f =
incomplete "field"
let matter_field f =
incomplete "matter_field"
let gauge_boson f =
incomplete "gauge_boson"
let other f =
incomplete "other"
let amplitude = CM.amplitude
let flow = CM.flow
end
(*i
* Local Variables:
* mode:caml
* indent-tabs-mode:nil
* page-delimiter:"^(\\* .*\n"
* End:
i*)
Index: trunk/src/omega/src/coupling.mli
===================================================================
--- trunk/src/omega/src/coupling.mli (revision 3998)
+++ trunk/src/omega/src/coupling.mli (revision 3999)
@@ -1,2557 +1,2559 @@
(* $Id$
Copyright (C) 1999-2012 by
Wolfgang Kilian <kilian@physik.uni-siegen.de>
Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
Juergen Reuter <juergen.reuter@desy.de>
Christian Speckner <christian.speckner@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. *)
(* The enumeration types used for communication from [Models]
to [Targets]. On the physics side, the modules in [Models]
must implement the Feynman rules according to the conventions
set up here. On the numerics side, the modules in [Targets]
must handle all cases according to the same conventions. *)
(* \thocwmodulesection{Propagators}
The Lorentz representation of the particle. NB: O'Mega
treats all lines as \emph{outgoing} and particles are therefore
transforming as [ConjSpinor] and antiparticles as [Spinor]. *)
type lorentz =
| Scalar
| Spinor (* $\psi$ *)
| ConjSpinor (* $\bar\psi$ *)
| Majorana (* $\chi$ *)
| Maj_Ghost (* SUSY ghosts *)
| Vector
(*i | Ward_Vector i*)
| Massive_Vector
| Vectorspinor (* supersymmetric currents and gravitinos *)
| Tensor_1
| Tensor_2 (* massive gravitons (large extra dimensions) *)
| BRS of lorentz
(* \begin{table}
\begin{center}
\renewcommand{\arraystretch}{2.2}
\begin{tabular}{|r|l|l|}\hline
& only Dirac fermions & incl.~Majorana fermions \\\hline
[Prop_Scalar]
& \multicolumn{2}{l|}{%
$\displaystyle\phi(p)\leftarrow
\frac{\ii}{p^2-m^2+\ii m\Gamma}\phi(p)$} \\\hline
[Prop_Spinor]
& $\displaystyle\psi(p)\leftarrow
\frac{\ii(-\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma}\psi(p)$
& $\displaystyle\psi(p)\leftarrow
\frac{\ii(-\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma}\psi(p)$ \\\hline
[Prop_ConjSpinor]
& $\displaystyle\bar\psi(p)\leftarrow
\bar\psi(p)\frac{\ii(\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma}$
& $\displaystyle\psi(p)\leftarrow
\frac{\ii(-\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma}\psi(p)$ \\\hline
[Prop_Majorana]
& \multicolumn{1}{c|}{N/A}
& $\displaystyle\chi(p)\leftarrow
\frac{\ii(-\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma}\chi(p)$ \\\hline
[Prop_Unitarity]
& \multicolumn{2}{l|}{%
$\displaystyle\epsilon_\mu(p)\leftarrow
\frac{\ii}{p^2-m^2+\ii m\Gamma}
\left(-g_{\mu\nu}+\frac{p_\mu p_\nu}{m^2}\right)\epsilon^\nu(p)$} \\\hline
[Prop_Feynman]
& \multicolumn{2}{l|}{%
$\displaystyle\epsilon^\nu(p)\leftarrow
\frac{-\ii}{p^2-m^2+\ii m\Gamma}\epsilon^\nu(p)$} \\\hline
[Prop_Gauge]
& \multicolumn{2}{l|}{%
$\displaystyle\epsilon_\mu(p)\leftarrow
\frac{\ii}{p^2}
\left(-g_{\mu\nu}+(1-\xi)\frac{p_\mu p_\nu}{p^2}\right)\epsilon^\nu(p)$} \\\hline
[Prop_Rxi]
& \multicolumn{2}{l|}{%
$\displaystyle\epsilon_\mu(p)\leftarrow
\frac{\ii}{p^2-m^2+\ii m\Gamma}
\left(-g_{\mu\nu}+(1-\xi)\frac{p_\mu p_\nu}{p^2-\xi m^2}\right)
\epsilon^\nu(p)$} \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:propagators} Propagators. NB: The sign of the
momenta in the spinor propagators comes about because O'Mega
treats all momenta as \emph{outgoing} and the charge flow for
[Spinor] is therefore opposite to the momentum, while the charge
flow for [ConjSpinor] is parallel to the momentum.}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.5}
\begin{tabular}{|r|l|}\hline
[Aux_Scalar]
& $\displaystyle\phi(p)\leftarrow\ii\phi(p)$ \\\hline
[Aux_Spinor]
& $\displaystyle\psi(p)\leftarrow\ii\psi(p)$ \\\hline
[Aux_ConjSpinor]
& $\displaystyle\bar\psi(p)\leftarrow\ii\bar\psi(p)$ \\\hline
[Aux_Vector]
& $\displaystyle\epsilon^\mu(p)\leftarrow\ii\epsilon^\mu(p)$ \\\hline
[Aux_Tensor_1]
& $\displaystyle T^{\mu\nu}(p)\leftarrow\ii T^{\mu\nu}(p)$ \\\hline
[Only_Insertion]
& \multicolumn{1}{c|}{N/A} \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:aux-propagators} Auxiliary and non propagating fields}
\end{table}
If there were no vectors or auxiliary fields, we could deduce the propagator from
the Lorentz representation. While we're at it, we can introduce
``propagators'' for the contact interactions of auxiliary fields
as well. [Prop_Gauge] and [Prop_Feynman] are redundant as special
cases of [Prop_Rxi].
The special case [Only_Insertion] corresponds to operator insertions
that do not correspond to a propagating field all. These are used
for checking Slavnov-Taylor identities
\begin{equation}
\partial_\mu\Braket{\text{out}|W^\mu(x)|\text{in}}
= m_W\Braket{\text{out}|\phi(x)|\text{in}}
\end{equation}
of gauge theories in unitarity gauge where the Goldstone bosons are
not propagating. Numerically, it would suffice to use a vanishing
propagator, but then superflous fusions would be calculated in
production code in which the Slavnov-Taylor identities are not tested. *)
type 'a propagator =
| Prop_Scalar | Prop_Ghost
| Prop_Spinor | Prop_ConjSpinor | Prop_Majorana
| Prop_Unitarity | Prop_Feynman | Prop_Gauge of 'a | Prop_Rxi of 'a
| Prop_Tensor_2 | Prop_Vectorspinor
| Prop_Col_Scalar | Prop_Col_Feynman | Prop_Col_Majorana
| Prop_Col_Unitarity
| Aux_Scalar | Aux_Vector | Aux_Tensor_1
| Aux_Col_Vector | Aux_Col_Tensor_1
| Aux_Spinor | Aux_ConjSpinor | Aux_Majorana
| Only_Insertion
(* \begin{JR}
We don't need different fermionic propagators as supposed by the variable
names [Prop_Spinor], [Prop_ConjSpinor] or [Prop_Majorana]. The
propagator in all cases has to be multiplied on the left hand side of the
spinor out of which a new one should be built. All momenta are treated as
\emph{outgoing}, so for the propagation of the different fermions the
following table arises, in which the momentum direction is always downwards
and the arrows show whether the momentum and the fermion line,
respectively are parallel or antiparallel to the direction of calculation:
\begin{center}
\begin{tabular}{|l|c|c|c|c|}\hline
Fermion type & fermion arrow & mom. & calc. & sign \\\hline\hline
Dirac fermion & $\uparrow$ & $\uparrow~\downarrow$ &
$\uparrow~\uparrow$ & negative \\\hline
Dirac antifermion & $\downarrow$ & $\downarrow~\downarrow$ &
$\uparrow~\downarrow$ & negative \\\hline
Majorana fermion & - & $\uparrow~\downarrow$ & - & negative \\\hline
\end{tabular}
\end{center}
So the sign of the momentum is always negative and no further distinction
is needed.
\end{JR} *)
type width =
| Vanishing
| Constant
| Timelike
| Running
| Fudged
| Custom of string
(* \thocwmodulesection{Vertices}
The combined $S-P$ and $V-A$ couplings (see
tables~\ref{tab:dim4-fermions-SP}, \ref{tab:dim4-fermions-VA},
\ref{tab:dim4-fermions-SPVA-maj} and~\ref{tab:dim4-fermions-SPVA-maj2})
are redundant, of course, but they allow some targets to create
more efficient numerical code.\footnote{An additional benefit
is that the counting of Feynman diagrams is not upset by a splitting
of the vectorial and axial pieces of gauge bosons.} Choosing VA2 over
VA will cause the FORTRAN backend to pass the coupling as a whole array *)
type fermion = Psi | Chi | Grav
type fermionbar = Psibar | Chibar | Gravbar
type boson =
| SP | SPM | S | P | SL | SR | SLR | VA | V | A | VL | VR | VLR | VLRM
| TVA | TLR | TRL | TVAM | TLRM | TRLM
| POT | MOM | MOM5 | MOML | MOMR | LMOM | RMOM | VMOM | VA2
type boson2 = S2 | P2 | S2P | S2L | S2R | S2LR
| SV | PV | SLV | SRV | SLRV | V2 | V2LR
(* The integer is an additional coefficient that multiplies the respective
coupling constant. This allows to reduce the number of required coupling
constants in manifestly symmetrc cases. Most of times it will be equal
unity, though. *)
(* The two vertex types [PBP] and [BBB] for the couplings of two fermions or
two antifermions ("clashing arrows") is unavoidable in supersymmetric
theories.
\begin{dubious}
\ldots{} tho doesn't like the names and has promised to find a better
mnemonics!
\end{dubious} *)
type 'a vertex3 =
| FBF of int * fermionbar * boson * fermion
| PBP of int * fermion * boson * fermion
| BBB of int * fermionbar * boson * fermionbar
| GBG of int * fermionbar * boson * fermion (* gravitino-boson-fermion *)
| Gauge_Gauge_Gauge of int | Aux_Gauge_Gauge of int
| Scalar_Vector_Vector of int
| Aux_Vector_Vector of int | Aux_Scalar_Vector of int
| Scalar_Scalar_Scalar of int | Aux_Scalar_Scalar of int
| Vector_Scalar_Scalar of int
| Graviton_Scalar_Scalar of int
| Graviton_Vector_Vector of int
| Graviton_Spinor_Spinor of int
| Dim4_Vector_Vector_Vector_T of int
| Dim4_Vector_Vector_Vector_L of int
| Dim4_Vector_Vector_Vector_T5 of int
| Dim4_Vector_Vector_Vector_L5 of int
| Dim6_Gauge_Gauge_Gauge of int
| Dim6_Gauge_Gauge_Gauge_5 of int
| Aux_DScalar_DScalar of int | Aux_Vector_DScalar of int
| Dim5_Scalar_Gauge2 of int (* %
$\frac12 \phi F_{1,\mu\nu} F_2^{\mu\nu} = - \frac12
\phi (\ii \partial_{[\mu,} V_{1,\nu]})(\ii \partial^{[\mu,} V_2^{\nu]})$ *)
| Dim5_Scalar_Gauge2_Skew of int
(* %
$\frac12 \phi F_{1,\mu\nu} \tilde{F}_2^{\mu\nu} = -
\phi (\ii \partial_\mu V_{1,\nu})(\ii \partial_\rho V_{2,\sigma})\epsilon^{\mu\nu\rho\sigma}$ *)
| Dim5_Scalar_Vector_Vector_T of int (* %
$\phi(\ii\partial_\mu V_1^\nu)(\ii\partial_\nu V_2^\mu)$ *)
- | Dim5_Scalar_Vector_Vector_U of int (* %
+ | Dim5_Scalar_Vector_Vector_TU of int (* %
$(\ii\partial_\nu\phi) (\ii\partial_\mu V_1^\nu) V_2^\mu$ *)
+ | Dim5_Scalar_Vector_Vector_U of int (* %
+ $(\ii\partial_\nu\phi) (\ii\partial_\mu V^\nu) V^\mu$ *)
| Dim6_Vector_Vector_Vector_T of int (* %
$V_1^\mu ((\ii\partial_\nu V_2^\rho)%
\ii\overleftrightarrow{\partial_\mu}(\ii\partial_\rho V_3^\nu))$ *)
| Tensor_2_Vector_Vector of int (* %
$T^{\mu\nu} (V_{1,\mu}V_{2,\nu} + V_{1,\nu}V_{2,\mu})$ *)
| Dim5_Tensor_2_Vector_Vector_1 of int (* %
$T^{\alpha\beta} (V_1^\mu
\ii\overleftrightarrow\partial_\alpha
\ii\overleftrightarrow\partial_\beta V_{2,\mu}$ *)
| Dim5_Tensor_2_Vector_Vector_2 of int
(* %
$T^{\alpha\beta}
( V_1^\mu \ii\overleftrightarrow\partial_\beta (\ii\partial_\mu V_{2,\alpha})
+ V_1^\mu \ii\overleftrightarrow\partial_\alpha (\ii\partial_\mu V_{2,\beta}))$ *)
| Dim7_Tensor_2_Vector_Vector_T of int (* %
$T^{\alpha\beta} ((\ii\partial^\mu V_1^\nu)
\ii\overleftrightarrow\partial_\alpha
\ii\overleftrightarrow\partial_\beta
(\ii\partial_\nu V_{2,\mu})) $ *)
(* As long as we stick to renormalizable couplings, there are only
three types of quartic couplings: [Scalar4], [Scalar2_Vector2]
and [Vector4]. However, there are three inequivalent contractions
for the latter and the general vertex will be a linear combination
with integer coefficients:
\begin{subequations}
\begin{align}
\ocwupperid{Scalar4}\,1 :&\;\;\;\;\;
\phi_1 \phi_2 \phi_3 \phi_4 \\
\ocwupperid{Scalar2\_Vector2}\,1 :&\;\;\;\;\;
\phi_1^{\vphantom{\mu}} \phi_2^{\vphantom{\mu}}
V_3^\mu V_{4,\mu}^{\vphantom{\mu}} \\
\ocwupperid{Vector4}\,\lbrack 1, \ocwupperid{C\_12\_34} \rbrack :&\;\;\;\;\;
V_1^\mu V_{2,\mu}^{\vphantom{\mu}}
V_3^\nu V_{4,\nu}^{\vphantom{\mu}} \\
\ocwupperid{Vector4}\,\lbrack 1, \ocwupperid{C\_13\_42} \rbrack :&\;\;\;\;\;
V_1^\mu V_2^\nu
V_{3,\mu}^{\vphantom{\mu}} V_{4,\nu}^{\vphantom{\mu}} \\
\ocwupperid{Vector4}\,\lbrack 1, \ocwupperid{C\_14\_23} \rbrack :&\;\;\;\;\;
V_1^\mu V_2^\nu
V_{3,\nu}^{\vphantom{\mu}} V_{4,\mu}^{\vphantom{\mu}}
\end{align}
\end{subequations} *)
type contract4 = C_12_34 | C_13_42 | C_14_23
(*i\begin{dubious}
CS objected to the polymorphic [type 'a vertex4], since it broke the
implementation of some of his extensions. Is there another way of
getting coupling constants into [Vector4_K_Matrix], besides the brute
force solution of declaring the possible coupling constants here?
\textit{I'd like to put the blame on CS for two reasons: it's not clear
that the brute force solution will actually work and everytime a new
vertex that depends non-linearly on coupling contanst pops up, the
problem will make another appearance.}
\end{dubious}i*)
type 'a vertex4 =
| Scalar4 of int
| Scalar2_Vector2 of int
| Vector4 of (int * contract4) list
| DScalar4 of (int * contract4) list
| DScalar2_Vector2 of (int * contract4) list
| GBBG of int * fermionbar * boson2 * fermion
(* In some applications, we have to allow for contributions outside of
perturbation theory. The most prominent example is heavy gauge boson
scattering at very high energies, where the perturbative expression
violates unitarity. *)
(* One solution is the `$K$-matrix' ansatz. Such unitarizations typically
introduce effective propagators and/or vertices that violate crossing
symmetry and vanish in the $t$-channel. This can be taken care of in
[Fusion] by filtering out vertices that have the wrong momenta. *)
(* In this case the ordering of the fields in a vertex of the Feynman
rules becomes significant. In particular, we assume that $(V_1,V_2,V_3,V_4)$
implies
\begin{equation}
\parbox{25mm}{\fmfframe(2,3)(2,3){\begin{fmfgraph*}(20,20)
\fmfleft{v1,v2}
\fmfright{v4,v3}
\fmflabel{$V_1$}{v1}
\fmflabel{$V_2$}{v2}
\fmflabel{$V_3$}{v3}
\fmflabel{$V_4$}{v4}
\fmf{plain}{v,v1}
\fmf{plain}{v,v2}
\fmf{plain}{v,v3}
\fmf{plain}{v,v4}
\fmfblob{.2w}{v}
\end{fmfgraph*}}}
\qquad\Longrightarrow\qquad
\parbox{45mm}{\fmfframe(2,3)(2,3){\begin{fmfgraph*}(40,20)
\fmfleft{v1,v2}
\fmfright{v4,v3}
\fmflabel{$V_1$}{v1}
\fmflabel{$V_2$}{v2}
\fmflabel{$V_3$}{v3}
\fmflabel{$V_4$}{v4}
\fmf{plain}{v1,v12,v2}
\fmf{plain}{v3,v34,v4}
\fmf{dots,label=$\Theta((p_1+p_2)^2)$,tension=0.7}{v12,v34}
\fmfdot{v12,v34}
\end{fmfgraph*}}}
\end{equation}
The list of pairs of parameters denotes the location and strengths
of the poles in the $K$-matrix ansatz:
\begin{equation}
(c_1,a_1,c_2,a_2,\ldots,c_n,a_n) \Longrightarrow
f(s) = \sum_{i=1}^{n} \frac{c_i}{s-a_i}
\end{equation} *)
| Vector4_K_Matrix_tho of int * ('a * 'a) list
| Vector4_K_Matrix_jr of int * (int * contract4) list
type 'a vertexn = unit
(* An obvious candidate for addition to [boson] is [T], of course. *)
(* \begin{dubious}
This list is sufficient for the minimal standard model, but not comprehensive
enough for most of its extensions, supersymmetric or otherwise.
In particular, we need a \emph{general} parameterization for all trilinear
vertices. One straightforward possibility are polynomials in the momenta for
each combination of fields.
\end{dubious}
\begin{JR}
Here we use the rules which can be found in~\cite{Denner:Majorana}
and are more properly described in [Targets] where the performing of the fusion
rules in analytical expressions is encoded.
\end{JR}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.2}
\begin{tabular}{|r|l|l|}\hline
& only Dirac fermions & incl.~Majorana fermions \\\hline
\multicolumn{3}{|l|}{[FBF (Psibar, S, Psi)]:
$\mathcal{L}_I=g_S\bar\psi_1 S\psi_2$}\\\hline
[F12] & $\bar\psi_2\leftarrow\ii\cdot g_S\bar\psi_1 S$
& $\psi_2\leftarrow\ii\cdot g_S\psi_1 S$ \\\hline
[F21] & $\bar\psi_2\leftarrow\ii\cdot g_S S \bar\psi_1$
& $\psi_2\leftarrow\ii\cdot g_SS\psi_1$ \\\hline
[F13] & $S\leftarrow\ii\cdot g_S\bar\psi_1\psi_2$
& $S\leftarrow\ii\cdot g_S\psi_1^T{\mathrm{C}}\psi_2$ \\\hline
[F31] & $S\leftarrow\ii\cdot g_S\psi_{2,\alpha}\bar\psi_{1,\alpha}$
& $S\leftarrow\ii\cdot g_S\psi_2^T{\mathrm{C}} \psi_1$\\\hline
[F23] & $\psi_1\leftarrow\ii\cdot g_SS\psi_2$
& $\psi_1\leftarrow\ii\cdot g_SS\psi_2$ \\\hline
[F32] & $\psi_1\leftarrow\ii\cdot g_S\psi_2 S$
& $\psi_1\leftarrow\ii\cdot g_S\psi_2 S$ \\\hline
\multicolumn{3}{|l|}{[FBF (Psibar, P, Psi)]:
$\mathcal{L}_I=g_P\bar\psi_1 P\gamma_5\psi_2$} \\\hline
[F12] & $\bar\psi_2\leftarrow\ii\cdot g_P\bar\psi_1\gamma_5 P$
& $\psi_2\leftarrow\ii\cdot g_P \gamma_5\psi_1 P$ \\\hline
[F21] & $\bar\psi_2\leftarrow\ii\cdot g_P P\bar\psi_1\gamma_5$
& $\psi_2\leftarrow\ii\cdot g_P P\gamma_5\psi_1$ \\\hline
[F13] & $P\leftarrow\ii\cdot g_P\bar\psi_1\gamma_5\psi_2$
& $P\leftarrow\ii\cdot g_P\psi_1^T {\mathrm{C}}\gamma_5\psi_2$ \\\hline
[F31] & $P\leftarrow\ii\cdot g_P[\gamma_5\psi_2]_\alpha\bar\psi_{1,\alpha}$
& $P\leftarrow\ii\cdot g_P\psi_2^T {\mathrm{C}}\gamma_5\psi_1$ \\\hline
[F23] & $\psi_1\leftarrow\ii\cdot g_P P\gamma_5\psi_2$
& $\psi_1\leftarrow\ii\cdot g_P P\gamma_5\psi_2$ \\\hline
[F32] & $\psi_1\leftarrow\ii\cdot g_P \gamma_5\psi_2 P$
& $\psi_1\leftarrow\ii\cdot g_P \gamma_5\psi_2 P$ \\\hline
\multicolumn{3}{|l|}{[FBF (Psibar, V, Psi)]:
$\mathcal{L}_I=g_V\bar\psi_1\fmslash{V}\psi_2$} \\\hline
[F12] & $\bar\psi_2\leftarrow\ii\cdot g_V\bar\psi_1\fmslash{V}$
& $\psi_{2,\alpha}\leftarrow\ii\cdot
(-g_V)\psi_{1,\beta}\fmslash{V}_{\alpha\beta}$ \\\hline
[F21] & $\bar\psi_{2,\beta}\leftarrow\ii\cdot
g_V\fmslash{V}_{\alpha\beta} \bar\psi_{1,\alpha}$
& $\psi_2\leftarrow\ii\cdot (-g_V)\fmslash{V}\psi_1$ \\\hline
[F13] & $V_\mu\leftarrow\ii\cdot g_V\bar\psi_1\gamma_\mu\psi_2$
& $V_\mu\leftarrow\ii\cdot
g_V (\psi_1)^T {\mathrm{C}}\gamma_{\mu}\psi_2$ \\\hline
[F31] & $V_\mu\leftarrow\ii\cdot g_V[\gamma_\mu\psi_2]_\alpha\bar\psi_{1,\alpha}$
& $V_\mu\leftarrow\ii\cdot
(-g_V)(\psi_2)^T {\mathrm{C}}\gamma_{\mu}\psi_1$ \\\hline
[F23] & $\psi_1\leftarrow\ii\cdot g_V\fmslash{V}\psi_2$
& $\psi_1\leftarrow\ii\cdot g_V\fmslash{V}\psi_2$ \\\hline
[F32] & $\psi_{1,\alpha}\leftarrow\ii\cdot
g_V\psi_{2,\beta}\fmslash{V}_{\alpha\beta}$
& $\psi_{1,\alpha}\leftarrow\ii\cdot
g_V\psi_{2,\beta}\fmslash{V}_{\alpha\beta}$ \\\hline
\multicolumn{3}{|l|}{[FBF (Psibar, A, Psi)]:
$\mathcal{L}_I=g_A\bar\psi_1\gamma_5\fmslash{A}\psi_2$} \\\hline
[F12] & $\bar\psi_2\leftarrow\ii\cdot g_A\bar\psi_1\gamma_5\fmslash{A}$
& $\psi_{2,\alpha}\leftarrow\ii\cdot
g_A\psi_{\beta}[\gamma_5\fmslash{A}]_{\alpha\beta}$ \\\hline
[F21] & $\bar\psi_{2,\beta}\leftarrow\ii\cdot g_A
[\gamma_5\fmslash{A}]_{\alpha\beta} \bar\psi_{1,\alpha}$
& $\psi_2\leftarrow\ii\cdot g_A \gamma_5\fmslash{A}\psi$ \\\hline
[F13] & $A_\mu\leftarrow\ii\cdot g_A\bar\psi_1\gamma_5\gamma_\mu\psi_2$
& $A_\mu\leftarrow\ii\cdot
g_A \psi_1^T {\textrm{C}}\gamma_5\gamma_{\mu}\psi_2$ \\\hline
[F31] & $A_\mu\leftarrow\ii\cdot
g_A[\gamma_5\gamma_\mu\psi_2]_\alpha\bar\psi_{1,\alpha}$
& $A_\mu\leftarrow\ii\cdot
g_A \psi_2^T {\textrm{C}}\gamma_5\gamma_{\mu}\psi_1$ \\\hline
[F23] & $\psi_1\leftarrow\ii\cdot g_A\gamma_5\fmslash{A}\psi_2$
& $\psi_1\leftarrow\ii\cdot g_A\gamma_5\fmslash{A}\psi_2$ \\\hline
[F32] & $\psi_{1,\alpha}\leftarrow\ii\cdot g_A
\psi_{2,\beta}[\gamma_5\fmslash{A}]_{\alpha\beta}$
& $\psi_{1,\alpha}\leftarrow\ii\cdot
g_A\psi_{2,\beta}[\gamma_5\fmslash{A}]_{\alpha\beta}$ \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:dim4-fermions} Dimension-4 trilinear fermionic couplings.
The momenta are unambiguous, because there are no derivative couplings
and all participating fields are different.}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.3}
\begin{tabular}{|r|l|l|}\hline
& only Dirac fermions & incl.~Majorana fermions \\\hline
\multicolumn{3}{|l|}{[FBF (Psibar, T, Psi)]:
$\mathcal{L}_I=g_TT_{\mu\nu}\bar\psi_1
[\gamma^\mu,\gamma^\nu]_-\psi_2$}\\\hline
[F12] & $\bar\psi_2\leftarrow\ii\cdot g_T
\bar\psi_1[\gamma^\mu,\gamma^\nu]_-T_{\mu\nu}$
& $\bar\psi_2\leftarrow\ii\cdot g_T \cdots$ \\\hline
[F21] & $\bar\psi_2\leftarrow\ii\cdot g_T T_{\mu\nu}
\bar\psi_1[\gamma^\mu,\gamma^\nu]_-$
& $\bar\psi_2\leftarrow\ii\cdot g_T \cdots$ \\\hline
[F13] & $T_{\mu\nu}\leftarrow\ii\cdot g_T\bar\psi_1[\gamma_\mu,\gamma_\nu]_-\psi_2$
& $T_{\mu\nu}\leftarrow\ii\cdot g_T \cdots $ \\\hline
[F31] & $T_{\mu\nu}\leftarrow\ii\cdot g_T
[[\gamma_\mu,\gamma_\nu]_-\psi_2]_\alpha\bar\psi_{1,\alpha}$
& $T_{\mu\nu}\leftarrow\ii\cdot g_T \cdots $ \\\hline
[F23] & $\psi_1\leftarrow\ii\cdot g_T T_{\mu\nu}[\gamma^\mu,\gamma^\nu]_-\psi_2$
& $\psi_1\leftarrow\ii\cdot g_T \cdots$ \\\hline
[F32] & $\psi_1\leftarrow\ii\cdot g_T [\gamma^\mu,\gamma^\nu]_-\psi_2 T_{\mu\nu}$
& $\psi_1\leftarrow\ii\cdot g_T \cdots$ \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:dim5-fermions} Dimension-5 trilinear fermionic couplings
(NB: the coefficients and signs are not fixed yet).
The momenta are unambiguous, because there are no derivative couplings
and all participating fields are different.}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.3}
\begin{tabular}{|r|l|l|}\hline
& only Dirac fermions & incl.~Majorana fermions \\\hline
\multicolumn{3}{|l|}{[FBF (Psibar, SP, Psi)]:
$\mathcal{L}_I=\bar\psi_1\phi(g_S+g_P\gamma_5)\psi_2$}\\\hline
[F12] & $\bar\psi_2\leftarrow\ii\cdot\bar\psi_1(g_S+g_P\gamma_5)\phi$
& $\psi_2\leftarrow\ii\cdot \cdots$ \\\hline
[F21] & $\bar\psi_2\leftarrow\ii\cdot\phi\bar\psi_1(g_S+g_P\gamma_5)$
& $\psi_2\leftarrow\ii\cdot \cdots$ \\\hline
[F13] & $\phi\leftarrow\ii\cdot\bar\psi_1(g_S+g_P\gamma_5)\psi_2$
& $\phi\leftarrow\ii\cdot\cdots$ \\\hline
[F31] & $\phi\leftarrow\ii\cdot[(g_S+g_P\gamma_5)\psi_2]_\alpha\bar\psi_{1,\alpha}$
& $\phi\leftarrow\ii\cdot\cdots$ \\\hline
[F23] & $\psi_1\leftarrow\ii\cdot \phi(g_S+g_P\gamma_5)\psi_2$
& $\psi_1\leftarrow\ii\cdot\cdots$ \\\hline
[F32] & $\psi_1\leftarrow\ii\cdot(g_S+g_P\gamma_5)\psi_2\phi$
& $\psi_1\leftarrow\ii\cdot\cdots$ \\\hline
\multicolumn{3}{|l|}{[FBF (Psibar, SL, Psi)]:
$\mathcal{L}_I=g_L\bar\psi_1\phi(1-\gamma_5)\psi_2$}\\\hline
[F12] & $\bar\psi_2\leftarrow\ii\cdot g_L\bar\psi_1(1-\gamma_5)\phi$
& $\psi_2\leftarrow\ii\cdot \cdots$ \\\hline
[F21] & $\bar\psi_2\leftarrow\ii\cdot g_L\phi\bar\psi_1(1-\gamma_5)$
& $\psi_2\leftarrow\ii\cdot \cdots$ \\\hline
[F13] & $\phi\leftarrow\ii\cdot g_L\bar\psi_1(1-\gamma_5)\psi_2$
& $\phi\leftarrow\ii\cdot\cdots$ \\\hline
[F31] & $\phi\leftarrow\ii\cdot g_L[(1-\gamma_5)\psi_2]_\alpha\bar\psi_{1,\alpha}$
& $\phi\leftarrow\ii\cdot\cdots$ \\\hline
[F23] & $\psi_1\leftarrow\ii\cdot g_L\phi(1-\gamma_5)\psi_2$
& $\psi_1\leftarrow\ii\cdot\cdots$ \\\hline
[F32] & $\psi_1\leftarrow\ii\cdot g_L(1-\gamma_5)\psi_2\phi$
& $\psi_1\leftarrow\ii\cdot\cdots$ \\\hline
\multicolumn{3}{|l|}{[FBF (Psibar, SR, Psi)]:
$\mathcal{L}_I=g_R\bar\psi_1\phi(1+\gamma_5)\psi_2$}\\\hline
[F12] & $\bar\psi_2\leftarrow\ii\cdot g_R\bar\psi_1(1+\gamma_5)\phi$
& $\psi_2\leftarrow\ii\cdot \cdots$ \\\hline
[F21] & $\bar\psi_2\leftarrow\ii\cdot g_R\phi\bar\psi_1(1+\gamma_5)$
& $\psi_2\leftarrow\ii\cdot \cdots$ \\\hline
[F13] & $\phi\leftarrow\ii\cdot g_R\bar\psi_1(1+\gamma_5)\psi_2$
& $\phi\leftarrow\ii\cdot\cdots$ \\\hline
[F31] & $\phi\leftarrow\ii\cdot g_R[(1+\gamma_5)\psi_2]_\alpha\bar\psi_{1,\alpha}$
& $\phi\leftarrow\ii\cdot\cdots$ \\\hline
[F23] & $\psi_1\leftarrow\ii\cdot g_R\phi(1+\gamma_5)\psi_2$
& $\psi_1\leftarrow\ii\cdot\cdots$ \\\hline
[F32] & $\psi_1\leftarrow\ii\cdot g_R(1+\gamma_5)\psi_2\phi$
& $\psi_1\leftarrow\ii\cdot\cdots$ \\\hline
\multicolumn{3}{|l|}{[FBF (Psibar, SLR, Psi)]:
$\mathcal{L}_I=g_L\bar\psi_1\phi(1-\gamma_5)\psi_2
+g_R\bar\psi_1\phi(1+\gamma_5)\psi_2$}\\\hline
\end{tabular}
\end{center}
\caption{\label{tab:dim4-fermions-SP} Combined dimension-4 trilinear fermionic couplings.}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.3}
\begin{tabular}{|r|l|l|}\hline
& only Dirac fermions & incl.~Majorana fermions \\\hline
\multicolumn{3}{|l|}{[FBF (Psibar, VA, Psi)]:
$\mathcal{L}_I=\bar\psi_1\fmslash{Z}(g_V-g_A\gamma_5)\psi_2$}\\\hline
[F12] & $\bar\psi_2\leftarrow\ii\cdot\bar\psi_1\fmslash{Z}(g_V-g_A\gamma_5)$
& $\psi_2\leftarrow\ii\cdot \cdots$ \\\hline
[F21] & $\bar\psi_{2,\beta}\leftarrow\ii\cdot
[\fmslash{Z}(g_V-g_A\gamma_5)]_{\alpha\beta}\bar\psi_{1,\alpha}$
& $\psi_2\leftarrow\ii\cdot \cdots$ \\\hline
[F13] & $Z_\mu\leftarrow\ii\cdot\bar\psi_1\gamma_\mu(g_V-g_A\gamma_5)\psi_2$
& $Z_\mu\leftarrow\ii\cdot \cdots$ \\\hline
[F31] & $Z_\mu\leftarrow\ii\cdot
[\gamma_\mu(g_V-g_A\gamma_5)\psi_2]_\alpha\bar\psi_{1,\alpha}$
& $Z_\mu\leftarrow\ii\cdot \cdots$ \\\hline
[F23] & $\psi_1\leftarrow\ii\cdot\fmslash{Z}(g_V-g_A\gamma_5)\psi_2$
& $\psi_1\leftarrow\ii\cdot\cdots$ \\\hline
[F32] & $\psi_{1,\alpha}\leftarrow\ii\cdot
\psi_{2,\beta}[\fmslash{Z}(g_V-g_A\gamma_5)]_{\alpha\beta}$
& $\psi_1\leftarrow\ii\cdot\cdots$ \\\hline
\multicolumn{3}{|l|}{[FBF (Psibar, VL, Psi)]:
$\mathcal{L}_I=g_L\bar\psi_1\fmslash{Z}(1-\gamma_5)\psi_2$}\\\hline
[F12] & $\bar\psi_2\leftarrow\ii\cdot g_L\bar\psi_1\fmslash{Z}(1-\gamma_5)$
& $\psi_2\leftarrow\ii\cdot \cdots$ \\\hline
[F21] & $\bar\psi_{2,\beta}\leftarrow\ii\cdot
g_L[\fmslash{Z}(1-\gamma_5)]_{\alpha\beta}\bar\psi_{1,\alpha}$
& $\psi_2\leftarrow\ii\cdot \cdots$ \\\hline
[F13] & $Z_\mu\leftarrow\ii\cdot g_L\bar\psi_1\gamma_\mu(1-\gamma_5)\psi_2$
& $Z_\mu\leftarrow\ii\cdot \cdots$ \\\hline
[F31] & $Z_\mu\leftarrow\ii\cdot
g_L[\gamma_\mu(1-\gamma_5)\psi_2]_\alpha\bar\psi_{1,\alpha}$
& $Z_\mu\leftarrow\ii\cdot \cdots$ \\\hline
[F23] & $\psi_1\leftarrow\ii\cdot g_L\fmslash{Z}(1-\gamma_5)\psi_2$
& $\psi_1\leftarrow\ii\cdot\cdots$ \\\hline
[F32] & $\psi_{1,\alpha}\leftarrow\ii\cdot
g_L\psi_{2,\beta}[\fmslash{Z}(1-\gamma_5)]_{\alpha\beta}$
& $\psi_1\leftarrow\ii\cdot\cdots$ \\\hline
\multicolumn{3}{|l|}{[FBF (Psibar, VR, Psi)]:
$\mathcal{L}_I=g_R\bar\psi_1\fmslash{Z}(1+\gamma_5)\psi_2$}\\\hline
[F12] & $\bar\psi_2\leftarrow\ii\cdot g_R\bar\psi_1\fmslash{Z}(1+\gamma_5)$
& $\psi_2\leftarrow\ii\cdot \cdots$ \\\hline
[F21] & $\bar\psi_{2,\beta}\leftarrow\ii\cdot
g_R[\fmslash{Z}(1+\gamma_5)]_{\alpha\beta}\bar\psi_{1,\alpha}$
& $\psi_2\leftarrow\ii\cdot \cdots$ \\\hline
[F13] & $Z_\mu\leftarrow\ii\cdot g_R\bar\psi_1\gamma_\mu(1+\gamma_5)\psi_2$
& $Z_\mu\leftarrow\ii\cdot \cdots$ \\\hline
[F31] & $Z_\mu\leftarrow\ii\cdot
g_R[\gamma_\mu(1+\gamma_5)\psi_2]_\alpha\bar\psi_{1,\alpha}$
& $Z_\mu\leftarrow\ii\cdot \cdots$ \\\hline
[F23] & $\psi_1\leftarrow\ii\cdot g_R\fmslash{Z}(1+\gamma_5)\psi_2$
& $\psi_1\leftarrow\ii\cdot\cdots$ \\\hline
[F32] & $\psi_{1,\alpha}\leftarrow\ii\cdot
g_R\psi_{2,\beta}[\fmslash{Z}(1+\gamma_5)]_{\alpha\beta}$
& $\psi_1\leftarrow\ii\cdot\cdots$ \\\hline
\multicolumn{3}{|l|}{[FBF (Psibar, VLR, Psi)]:
$\mathcal{L}_I=g_L\bar\psi_1\fmslash{Z}(1-\gamma_5)\psi_2
+g_R\bar\psi_1\fmslash{Z}(1+\gamma_5)\psi_2$}\\\hline
\end{tabular}
\end{center}
\caption{\label{tab:dim4-fermions-VA} Combined dimension-4 trilinear
fermionic couplings continued.}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.4}
\begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline
\multicolumn{4}{|l|}{[FBF (Psibar, S, Chi)]: $\bar\psi S\chi$}\\\hline
[F12] & $\chi\leftarrow\psi S$
& [F21] & $\chi\leftarrow S \psi$ \\\hline
[F13] & $S\leftarrow \psi^T{\rm C}\chi$
& [F31] & $S\leftarrow \chi^T {\rm C}\psi$ \\\hline
[F23] & $\psi\leftarrow S\chi$
& [F32] & $\psi\leftarrow\chi S$ \\\hline
\multicolumn{4}{|l|}{[FBF (Psibar, P, Chi)]: $\bar\psi P\gamma_5\chi$}\\\hline
[F12] & $\chi\leftarrow \gamma_5 \psi P$
& [F21] & $\chi\leftarrow P \gamma_5 \psi$ \\\hline
[F13] & $P\leftarrow \psi^T {\rm C}\gamma_5\chi$
& [F31] & $P\leftarrow \chi^T {\rm C}\gamma_5\psi$ \\\hline
[F23] & $\psi\leftarrow P\gamma_5\chi$
& [F32] & $\psi\leftarrow\gamma_5\chi P$ \\\hline
\multicolumn{4}{|l|}{[FBF (Psibar, V, Chi)]: $\bar\psi\fmslash{V}\chi$}\\\hline
[F12] & $\chi_{\alpha}\leftarrow-\psi_{\beta}\fmslash{V}_{\alpha\beta}$
& [F21] & $\chi\leftarrow-\fmslash{V}\psi$ \\\hline
[F13] & $V_{\mu}\leftarrow \psi^T {\rm C}\gamma_{\mu}\chi$
& [F31] & $V_{\mu}\leftarrow \chi^T {\rm C}(-\gamma_{\mu}\psi)$ \\\hline
[F23] & $\psi\leftarrow\fmslash{V}\chi$
& [F32] & $\psi_\alpha\leftarrow\chi_\beta\fmslash{V}_{\alpha\beta}$ \\\hline
\multicolumn{4}{|l|}{[FBF (Psibar, A, Chi)]: $\bar\psi\gamma^5\fmslash{A}\chi$}\\\hline
[F12] & $\chi_{\alpha}\leftarrow\psi_{\beta}\lbrack \gamma^5 \fmslash{A} \rbrack_{\alpha\beta}$
& [F21] & $\chi\leftarrow\gamma^5\fmslash{A}\psi$ \\\hline
[F13] & $A_{\mu}\leftarrow \psi^T {\rm C}\gamma^5\gamma_{\mu}\chi$
& [F31] & $A_{\mu}\leftarrow \chi^T {\rm C}(\gamma^5 \gamma_{\mu}\psi)$ \\\hline
[F23] & $\psi\leftarrow\gamma^5\fmslash{A}\chi$
& [F32] & $\psi_\alpha\leftarrow\chi_\beta\lbrack \gamma^5 \fmslash{A} \rbrack_{\alpha\beta}$ \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:dim4-fermions-maj} Dimension-4 trilinear couplings
including one Dirac and one Majorana fermion}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.4}
\begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline
\multicolumn{4}{|l|}{[FBF (Psibar, SP, Chi)]:
$\bar\psi\phi(g_S+g_P\gamma_5)\chi$}\\\hline
[F12] & $\chi \leftarrow (g_S+g_P\gamma_5)\psi \phi$
& [F21] & $\chi\leftarrow\phi(g_S+g_P\gamma_5)\psi$ \\\hline
[F13] & $\phi\leftarrow \psi^T {\rm C}(g_S+g_P\gamma_5)\chi$
& [F31] & $\phi\leftarrow \chi^T {\rm C}(g_S+g_P\gamma_5) \chi$ \\\hline
[F23] & $\psi\leftarrow \phi(g_S+g_P\gamma_5)\chi$
& [F32] & $\psi\leftarrow(g_S+g_P\gamma_5)\chi\phi$ \\\hline
\multicolumn{4}{|l|}{[FBF (Psibar, VA, Chi)]:
$\bar\psi\fmslash{Z}(g_V - g_A\gamma_5)\chi$}\\\hline
[F12] & $\chi_\alpha\leftarrow
\psi_\beta[\fmslash{Z}(-g_V-g_A\gamma_5)]_{\alpha\beta}$
& [F21] & $\chi\leftarrow\fmslash{Z}(-g_V-g_A\gamma_5)]
\psi$ \\\hline
[F13] & $Z_\mu\leftarrow \psi^T {\rm C}\gamma_\mu(g_V-g_A\gamma_5)\chi$
& [F31] & $Z_\mu\leftarrow \chi^T {\rm C}\gamma_\mu(-g_V-g_A\gamma_5)\psi$ \\\hline
[F23] & $\psi\leftarrow\fmslash{Z}(g_V-g_A\gamma_5)\chi$
& [F32] & $\psi_\alpha\leftarrow
\chi_\beta[\fmslash{Z}(g_V-g_A\gamma_5)]_{\alpha\beta}$ \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:dim4-fermions-SPVA-maj} Combined dimension-4 trilinear
fermionic couplings including one Dirac and one Majorana fermion.}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.4}
\begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline
\multicolumn{4}{|l|}{[FBF (Chibar, S, Psi)]: $\bar\chi S\psi$}\\\hline
[F12] & $\psi\leftarrow\chi S$
& [F21] & $\psi\leftarrow S\chi$ \\\hline
[F13] & $S\leftarrow \chi^T {\rm C}\psi$
& [F31] & $S\leftarrow \psi^T {\rm C}\chi$ \\\hline
[F23] & $\chi\leftarrow S \psi$
& [F32] & $\chi\leftarrow\psi S$ \\\hline
\multicolumn{4}{|l|}{[FBF (Chibar, P, Psi)]: $\bar\chi P\gamma_5\psi$}\\\hline
[F12] & $\psi\leftarrow\gamma_5\chi P$
& [F21] & $\psi\leftarrow P\gamma_5\chi$ \\\hline
[F13] & $P\leftarrow \chi^T {\rm C}\gamma_5\psi$
& [F31] & $P\leftarrow \psi^T {\rm C}\gamma_5\chi$ \\\hline
[F23] & $\chi\leftarrow P \gamma_5 \psi$
& [F32] & $\chi\leftarrow \gamma_5 \psi P$ \\\hline
\multicolumn{4}{|l|}{[FBF (Chibar, V, Psi)]: $\bar\chi\fmslash{V}\psi$}\\\hline
[F12] & $\psi_\alpha\leftarrow-\chi_\beta\fmslash{V}_{\alpha\beta}$
& [F21] & $\psi\leftarrow-\fmslash{V}\chi$ \\\hline
[F13] & $V_{\mu}\leftarrow \chi^T {\rm C}\gamma_{\mu}\psi$
& [F31] & $V_{\mu}\leftarrow \psi^T {\rm C}(-\gamma_{\mu}\chi)$ \\\hline
[F23] & $\chi\leftarrow\fmslash{V}\psi$
& [F32] & $\chi_{\alpha}\leftarrow\psi_{\beta}\fmslash{V}_{\alpha\beta}$ \\\hline
\multicolumn{4}{|l|}{[FBF (Chibar, A, Psi)]: $\bar\chi\gamma^5\fmslash{A}\psi$}\\\hline
[F12] & $\psi_\alpha\leftarrow\chi_\beta\lbrack\gamma^5\fmslash{A} \rbrack_{\alpha\beta}$
& [F21] & $\psi\leftarrow\gamma^5\fmslash{A}\chi$ \\\hline
[F13] & $A_{\mu}\leftarrow \chi^T {\rm C}(\gamma^5\gamma_{\mu}\psi)$
& [F31] & $A_{\mu}\leftarrow \psi^T {\rm C}\gamma^5\gamma_{\mu}\chi$ \\\hline
[F23] & $\chi\leftarrow\gamma^5\fmslash{A}\psi$
& [F32] & $\chi_{\alpha}\leftarrow\psi_{\beta}\lbrack\gamma^5\fmslash{A} \rbrack_{\alpha\beta}$ \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:dim4-fermions-maj'} Dimension-4 trilinear couplings
including one Dirac and one Majorana fermion}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.4}
\begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline
\multicolumn{4}{|l|}{[FBF (Chibar, SP, Psi)]: $\bar\chi\phi(g_S+g_P\gamma_5)\psi$}\\\hline
[F12] & $\psi\leftarrow(g_S+g_P\gamma_5)\chi\phi$
& [F21] & $\psi\leftarrow \phi(g_S+g_P\gamma_5)\chi$ \\\hline
[F13] & $\phi\leftarrow \chi^T {\rm C}(g_S+g_P\gamma_5) \psi$
& [F31] & $\phi\leftarrow \psi^T {\rm C}(g_S+g_P\gamma_5)\chi$ \\\hline
[F23] & $\chi\leftarrow\phi(g_S+g_P\gamma_5)\psi$
& [F32] & $\chi \leftarrow (g_S+g_P\gamma_5)\psi \phi$ \\\hline
\multicolumn{4}{|l|}{[FBF (Chibar, VA, Psi)]:
$\bar\chi\fmslash{Z}(g_V - g_A\gamma_5)\psi$}\\\hline
[F12] & $\psi_\alpha\leftarrow
\chi_\beta[\fmslash{Z}(-g_V-g_A\gamma_5)]_{\alpha\beta}$
& [F21] & $\psi\leftarrow\fmslash{Z}(-g_V-g_A\gamma_5)\chi$ \\\hline
[F13] & $Z_\mu\leftarrow \chi^T {\rm C}\gamma_\mu(g_V-g_A\gamma_5)\psi$
& [F31] & $Z_\mu\leftarrow \psi^T {\rm C}\gamma_\mu(-g_V-g_A\gamma_5)\chi$ \\\hline
[F23] & $\chi\leftarrow\fmslash{Z}(g_V-g_A\gamma_5)]
\psi$
& [F32] & $\chi_\alpha\leftarrow\psi_\beta[\fmslash{Z}(g_V-g_A\gamma_5)]_{\alpha\beta}$ \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:dim4-fermions-SPVA-maj'} Combined dimension-4 trilinear
fermionic couplings including one Dirac and one Majorana fermion.}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.4}
\begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline
\multicolumn{4}{|l|}{[FBF (Chibar, S, Chi)]: $\bar\chi_a S\chi_b$}\\\hline
[F12] & $\chi_b\leftarrow\chi_a S$
& [F21] & $\chi_b\leftarrow S \chi_a$ \\\hline
[F13] & $S\leftarrow \chi^T_a {\rm C}\chi_b$
& [F31] & $S\leftarrow \chi^T_b {\rm C}\chi_a$ \\\hline
[F23] & $\chi_a\leftarrow S\chi_b$
& [F32] & $\chi_a\leftarrow\chi S_b$ \\\hline
\multicolumn{4}{|l|}{[FBF (Chibar, P, Chi)]: $\bar\chi_a P\gamma_5\psi_b$}\\\hline
[F12] & $\chi_b\leftarrow \gamma_5 \chi_a P$
& [F21] & $\chi_b\leftarrow P \gamma_5 \chi_a$ \\\hline
[F13] & $P\leftarrow \chi^T_a {\rm C}\gamma_5\chi_b$
& [F31] & $P\leftarrow \chi^T_b {\rm C}\gamma_5\chi_a$ \\\hline
[F23] & $\chi_a\leftarrow P\gamma_5\chi_b$
& [F32] & $\chi_a\leftarrow\gamma_5\chi_b P$ \\\hline
\multicolumn{4}{|l|}{[FBF (Chibar, V, Chi)]: $\bar\chi_a\fmslash{V}\chi_b$}\\\hline
[F12] & $\chi_{b,\alpha}\leftarrow-\chi_{a,\beta}\fmslash{V}_{\alpha\beta}$
& [F21] & $\chi_b\leftarrow-\fmslash{V}\chi_a$ \\\hline
[F13] & $V_{\mu}\leftarrow \chi^T_a {\rm C}\gamma_{\mu}\chi_b$
& [F31] & $V_{\mu}\leftarrow - \chi^T_b {\rm C}\gamma_{\mu}\chi_a$ \\\hline
[F23] & $\chi_a\leftarrow\fmslash{V}\chi_b$
& [F32] & $\chi_{a,\alpha}\leftarrow\chi_{b,\beta}\fmslash{V}_{\alpha\beta}$ \\\hline
\multicolumn{4}{|l|}{[FBF (Chibar, A, Chi)]: $\bar\chi_a\gamma^5\fmslash{A}\chi_b$}\\\hline
[F12] & $\chi_{b,\alpha}\leftarrow\chi_{a,\beta}\lbrack\gamma^5\fmslash{A} \rbrack_{\alpha\beta}$
& [F21] & $\chi_b\leftarrow\gamma^5\fmslash{A}\chi_a$ \\\hline
[F13] & $A_{\mu}\leftarrow \chi^T_a {\rm C}\gamma^5\gamma_{\mu}\chi_b$
& [F31] & $A_{\mu}\leftarrow \chi^T_b {\rm C}(\gamma^5\gamma_{\mu}\chi_a)$ \\\hline
[F23] & $\chi_a\leftarrow\gamma^5\fmslash{A}\chi_b$
& [F32] & $\chi_{a,\alpha}\leftarrow\chi_{b,\beta}\lbrack\gamma^5\fmslash{A} \rbrack_{\alpha\beta}$ \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:dim4-fermions-maj2} Dimension-4 trilinear couplings
of two Majorana fermions}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.4}
\begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline
\multicolumn{4}{|l|}{[FBF (Chibar, SP, Chi)]:
$\bar\chi\phi_a(g_S+g_P\gamma_5)\chi_b$}\\\hline
[F12] & $\chi_b \leftarrow (g_S+g_P\gamma_5)\chi_a \phi$
& [F21] & $\chi_b\leftarrow\phi(g_S+g_P\gamma_5)\chi_a$ \\\hline
[F13] & $\phi\leftarrow \chi^T_a {\rm C}(g_S+g_P\gamma_5)\chi_b$
& [F31] & $\phi\leftarrow \chi^T_b {\rm C}(g_S+g_P\gamma_5) \chi_a$ \\\hline
[F23] & $\chi_a\leftarrow \phi(g_S+g_P\gamma_5)\chi_b$
& [F32] & $\chi_a\leftarrow(g_S+g_P\gamma_5)\chi_b\phi$ \\\hline
\multicolumn{4}{|l|}{[FBF (Chibar, VA, Chi)]:
$\bar\chi_a\fmslash{Z}(g_V-g_A\gamma_5)\chi_b$}\\\hline
[F12] & $\chi_{b,\alpha}\leftarrow\chi_{a,\beta}[\fmslash{Z}(-g_V-g_A\gamma_5)]_{\alpha\beta}$
& [F21] & $\chi_b\leftarrow\fmslash{Z}(-g_V-g_A\gamma_5)]\chi_a$ \\\hline
[F13] & $Z_\mu\leftarrow \chi^T_a {\rm C}\gamma_\mu(g_V-g_A\gamma_5)\chi_b$
& [F31] & $Z_\mu\leftarrow \chi^T_b {\rm C}\gamma_\mu(-g_V-g_A\gamma_5)\chi_a$ \\\hline
[F23] & $\chi_a\leftarrow\fmslash{Z}(g_V-g_A\gamma_5)\chi_b$
& [F32] & $\chi_{a,\alpha}\leftarrow
\chi_{b,\beta}[\fmslash{Z}(g_V-g_A\gamma_5)]_{\alpha\beta}$ \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:dim4-fermions-SPVA-maj2} Combined dimension-4 trilinear
fermionic couplings of two Majorana fermions.}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.3}
\begin{tabular}{|>{\qquad}r<{:}l|}\hline
\multicolumn{2}{|l|}{[Gauge_Gauge_Gauge]:
$\mathcal{L}_I=gf_{abc}
A_a^\mu A_b^\nu\partial_\mu A_{c,\nu}$}\\\hline
[_] & $A_a^\mu\leftarrow\ii\cdot
(-\ii g/2)\cdot C_{abc}^{\mu\rho\sigma}(-k_2-k_3,k_2,k_3)
A^b_\rho A^c_\sigma$\\\hline
\multicolumn{2}{|l|}{[Aux_Gauge_Gauge]:
$\mathcal{L}_I=gf_{abc}X_{a,\mu\nu}(k_1)
( A_b^{\mu}(k_2)A_c^{\nu}(k_3)
-A_b^{\nu}(k_2)A_c^{\mu}(k_3))$}\\\hline
[F23]$\lor$[F32] & $X_a^{\mu\nu}(k_2+k_3)\leftarrow\ii\cdot
gf_{abc}( A_b^\mu(k_2)A_c^\nu(k_3)
-A_b^\nu(k_2)A_c^\mu(k_3))$ \\\hline
[F12]$\lor$[F13] & $A_{a,\mu}(k_1+k_{2/3})\leftarrow\ii\cdot
gf_{abc}X_{b,\nu\mu}(k_1)A_c^\nu(k_{2/3})$ \\\hline
[F21]$\lor$[F31] & $A_{a,\mu}(k_{2/3}+k_1)\leftarrow\ii\cdot
gf_{abc}A_b^\nu(k_{2/3}) X_{c,\mu\nu}(k_1)$ \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:dim4-bosons} Dimension-4 Vector Boson couplings with
\emph{outgoing} momenta.
See~(\ref{eq:C123}) and~(\ref{eq:C123'}) for the definition of the
antisymmetric tensor $C^{\mu_1\mu_2\mu_3}(k_1,k_2,k_3)$.}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.3}
\begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline
\multicolumn{4}{|l|}{[Scalar_Vector_Vector]:
$\mathcal{L}_I=g\phi V_1^\mu V_{2,\mu}$}\\\hline
[F13] & $\leftarrow\ii\cdot g\cdots$
& [F31] & $\leftarrow\ii\cdot g\cdots$ \\\hline
[F12] & $\leftarrow\ii\cdot g\cdots$
& [F21] & $\leftarrow\ii\cdot g\cdots$ \\\hline
[F23] & $\phi\leftarrow\ii\cdot g V_1^\mu V_{2,\mu}$
& [F32] & $\phi\leftarrow\ii\cdot g V_{2,\mu} V_1^\mu$ \\\hline
\multicolumn{4}{|l|}{[Aux_Vector_Vector]:
$\mathcal{L}_I=gX V_1^\mu V_{2,\mu}$}\\\hline
[F13] & $\leftarrow\ii\cdot g\cdots$
& [F31] & $\leftarrow\ii\cdot g\cdots$ \\\hline
[F12] & $\leftarrow\ii\cdot g\cdots$
& [F21] & $\leftarrow\ii\cdot g\cdots$ \\\hline
[F23] & $X\leftarrow\ii\cdot g V_1^\mu V_{2,\mu}$
& [F32] & $X\leftarrow\ii\cdot g V_{2,\mu} V_1^\mu$ \\\hline
\multicolumn{4}{|l|}{[Aux_Scalar_Vector]:
$\mathcal{L}_I=gX^\mu \phi V_\mu$}\\\hline
[F13] & $\leftarrow\ii\cdot g\cdots$
& [F31] & $\leftarrow\ii\cdot g\cdots$ \\\hline
[F12] & $\leftarrow\ii\cdot g\cdots$
& [F21] & $\leftarrow\ii\cdot g\cdots$ \\\hline
[F23] & $\leftarrow\ii\cdot g\cdots$
& [F32] & $\leftarrow\ii\cdot g\cdots$ \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:scalar-vector}
\ldots}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.3}
\begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline
\multicolumn{4}{|l|}{[Scalar_Scalar_Scalar]:
$\mathcal{L}_I=g\phi_1\phi_2\phi_3$}\\\hline
[F13] & $\phi_2\leftarrow\ii\cdot g \phi_1\phi_3$
& [F31] & $\phi_2\leftarrow\ii\cdot g \phi_3\phi_1$ \\\hline
[F12] & $\phi_3\leftarrow\ii\cdot g \phi_1\phi_2$
& [F21] & $\phi_3\leftarrow\ii\cdot g \phi_2\phi_1$ \\\hline
[F23] & $\phi_1\leftarrow\ii\cdot g \phi_2\phi_3$
& [F32] & $\phi_1\leftarrow\ii\cdot g \phi_3\phi_2$ \\\hline
\multicolumn{4}{|l|}{[Aux_Scalar_Scalar]:
$\mathcal{L}_I=gX\phi_1\phi_2$}\\\hline
[F13] & $\leftarrow\ii\cdot g\cdots$
& [F31] & $\leftarrow\ii\cdot g\cdots$ \\\hline
[F12] & $\leftarrow\ii\cdot g\cdots$
& [F21] & $\leftarrow\ii\cdot g\cdots$ \\\hline
[F23] & $X\leftarrow\ii\cdot g \phi_1\phi_2$
& [F32] & $X\leftarrow\ii\cdot g \phi_2\phi_1$ \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:scalars}
\ldots}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.3}
\begin{tabular}{|>{\qquad}r<{:}l|}\hline
\multicolumn{2}{|l|}{[Vector_Scalar_Scalar]:
$\mathcal{L}_I=gV^\mu\phi_1
\ii\overleftrightarrow{\partial_\mu}\phi_2$}\\\hline
[F23] & $V^\mu(k_2+k_3)\leftarrow\ii\cdot
g(k_2^\mu-k_3^\mu)\phi_1(k_2)\phi_2(k_3)$ \\\hline
[F32] & $V^\mu(k_2+k_3)\leftarrow\ii\cdot
g(k_2^\mu-k_3^\mu)\phi_2(k_3)\phi_1(k_2)$ \\\hline
[F12] & $\phi_2(k_1+k_2)\leftarrow\ii\cdot
g(k_1^\mu+2k_2^\mu)V_\mu(k_1)\phi_1(k_2)$ \\\hline
[F21] & $\phi_2(k_1+k_2)\leftarrow\ii\cdot
g(k_1^\mu+2k_2^\mu)\phi_1(k_2)V_\mu(k_1)$ \\\hline
[F13] & $\phi_1(k_1+k_3)\leftarrow\ii\cdot
g(-k_1^\mu-2k_3^\mu)V_\mu(k_1)\phi_2(k_3)$ \\\hline
[F31] & $\phi_1(k_1+k_3)\leftarrow\ii\cdot
g(-k_1^\mu-2k_3^\mu)\phi_2(k_3)V_\mu(k_1)$ \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:scalar-current}
\ldots}
\end{table} *)
(* \begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.3}
\begin{tabular}{|>{\qquad}r<{:}l|}\hline
\multicolumn{2}{|l|}{[Aux_DScalar_DScalar]:
$\mathcal{L}_I=g\chi
(\ii\partial_\mu\phi_1)(\ii\partial^\mu\phi_2)$}\\\hline
[F23] & $\chi(k_2+k_3)\leftarrow\ii\cdot
g (k_2\cdot k_3) \phi_1(k_2) \phi_2(k_3) $ \\\hline
[F32] & $\chi(k_2+k_3)\leftarrow\ii\cdot
g (k_3\cdot k_2) \phi_2(k_3) \phi_1(k_2) $ \\\hline
[F12] & $\phi_2(k_1+k_2)\leftarrow\ii\cdot
g ((-k_1-k_2) \cdot k_2) \chi(k_1) \phi_1(k_2) $ \\\hline
[F21] & $\phi_2(k_1+k_2)\leftarrow\ii\cdot
g (k_2 \cdot (-k_1-k_2)) \phi_1(k_2) \chi(k_1) $ \\\hline
[F13] & $\phi_1(k_1+k_3)\leftarrow\ii\cdot
g ((-k_1-k_3) \cdot k_3) \chi(k_1) \phi_2(k_3) $ \\\hline
[F31] & $\phi_1(k_1+k_3)\leftarrow\ii\cdot
g (k_3 \cdot (-k_1-k_3)) \phi_2(k_3) \chi(k_1) $ \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:dscalar-dscalar}
\ldots}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.3}
\begin{tabular}{|>{\qquad}r<{:}l|}\hline
\multicolumn{2}{|l|}{[Aux_Vector_DScalar]:
$\mathcal{L}_I=g\chi V_\mu (\ii\partial^\mu\phi)$}\\\hline
[F23] & $\chi(k_2+k_3)\leftarrow\ii\cdot
g k_3^\mu V_\mu(k_2) \phi(k_3) $ \\\hline
[F32] & $\chi(k_2+k_3)\leftarrow\ii\cdot
g \phi(k_3) k_3^\mu V_\mu(k_2) $ \\\hline
[F12] & $\phi(k_1+k_2)\leftarrow\ii\cdot
g \chi(k_1) (-k_1-k_2)^\mu V_\mu(k_2) $ \\\hline
[F21] & $\phi(k_1+k_2)\leftarrow\ii\cdot
g (-k_1-k_2)^\mu V_\mu(k_2) \chi(k_1) $ \\\hline
[F13] & $V_\mu(k_1+k_3)\leftarrow\ii\cdot
g (-k_1-k_3)_\mu \chi(k_1) \phi(k_3) $ \\\hline
[F31] & $V_\mu(k_1+k_3)\leftarrow\ii\cdot
g (-k_1-k_3)_\mu \phi(k_3) \chi(k_1) $ \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:vector-dscalar}
\ldots}
\end{table}
*)
(* Signify which two of three fields are fused: *)
type fuse2 = F23 | F32 | F31 | F13 | F12 | F21
(* Signify which three of four fields are fused: *)
type fuse3 =
| F123 | F231 | F312 | F132 | F321 | F213
| F124 | F241 | F412 | F142 | F421 | F214
| F134 | F341 | F413 | F143 | F431 | F314
| F234 | F342 | F423 | F243 | F432 | F324
(* Explicit enumeration types make no sense for higher degrees. *)
type fusen = int list
(* The third member of the triplet will contain the coupling constant: *)
type 'a t =
| V3 of 'a vertex3 * fuse2 * 'a
| V4 of 'a vertex4 * fuse3 * 'a
| Vn of 'a vertexn * fusen * 'a
(* \thocwmodulesection{Gauge Couplings}
Dimension-4 trilinear vector boson couplings
\begin{subequations}
\begin{multline}
f_{abc}\partial^{\mu}A^{a,\nu}A^b_{\mu}A^c_{\nu} \rightarrow
\ii f_{abc}k_1^\mu A^{a,\nu}(k_1)A^b_{\mu}(k_2)A^c_{\nu}(k_3) \\
= -\frac{\ii}{3!} f_{a_1a_2a_3} C^{\mu_1\mu_2\mu_3}(k_1,k_2,k_3)
A^{a_1}_{\mu_1}(k_1)A^{a_2}_{\mu_2}(k_2)A^{a_3}_{\mu_3}(k_3)
\end{multline}
with the totally antisymmetric tensor (under simultaneous permutations
of all quantum numbers $\mu_i$ and $k_i$) and all momenta \emph{outgoing}
\begin{equation}
\label{eq:C123}
C^{\mu_1\mu_2\mu_3}(k_1,k_2,k_3) =
( g^{\mu_1\mu_2} (k_1^{\mu_3}-k_2^{\mu_3})
+ g^{\mu_2\mu_3} (k_2^{\mu_1}-k_3^{\mu_1})
+ g^{\mu_3\mu_1} (k_3^{\mu_2}-k_1^{\mu_2}) )
\end{equation}
\end{subequations}
Since~$f_{a_1a_2a_3}C^{\mu_1\mu_2\mu_3}(k_1,k_2,k_3)$ is totally symmetric
(under simultaneous permutations of all quantum numbers $a_i$, $\mu_i$ and $k_i$),
it is easy to take the partial derivative
\begin{subequations}
\label{eq:AofAA}
\begin{equation}
A^{a,\mu}(k_2+k_3) =
- \frac{\ii}{2!} f_{abc}C^{\mu\rho\sigma}(-k_2-k_3,k_2,k_3) A^b_\rho(k_2)A^c_\sigma(k_3)
\end{equation}
with
\begin{equation}
\label{eq:C123'}
C^{\mu\rho\sigma}(-k_2-k_3,k_2,k_3) =
( g^{\rho\sigma} ( k_2^{\mu} -k_3^{\mu} )
+ g^{\mu\sigma} (2k_3^{\rho} +k_2^{\rho} )
- g^{\mu\rho} (2k_2^{\sigma}+k_3^{\sigma}) )
\end{equation}
i.\,e.
\begin{multline}
\label{eq:fuse-gauge}
A^{a,\mu}(k_2+k_3) = - \frac{\ii}{2!} f_{abc}
\bigl( (k_2^{\mu}-k_3^{\mu})A^b(k_2) \cdot A^c(k_3) \\
+ (2k_3+k_2)\cdot A^b(k_2)A^{c,\mu}(k_3)
- A^{b,\mu}(k_2)A^c(k_3)\cdot(2k_2+k_3) \bigr)
\end{multline}
\end{subequations}
\begin{dubious}
Investigate the rearrangements proposed in~\cite{HELAS} for improved
numerical stability.
\end{dubious} *)
(* \thocwmodulesubsection{Non-Gauge Vector Couplings}
As a basis for the dimension-4 couplings of three vector bosons, we
choose ``transversal'' and ``longitudinal'' (with respect to the first
vector field) tensors that are odd and even under permutation of the
second and third argument
\begin{subequations}
\begin{align}
\mathcal{L}_T(V_1,V_2,V_3)
&= V_1^\mu (V_{2,\nu}\ii\overleftrightarrow{\partial_\mu}V_3^\nu)
= - \mathcal{L}_T(V_1,V_3,V_2) \\
\mathcal{L}_L(V_1,V_2,V_3)
&= (\ii\partial_\mu V_1^\mu) V_{2,\nu}V_3^\nu
= \mathcal{L}_L(V_1,V_3,V_2)
\end{align}
\end{subequations}
Using partial integration in~$\mathcal{L}_L$, we find the
convenient combinations
\begin{subequations}
\begin{align}
\mathcal{L}_T(V_1,V_2,V_3) + \mathcal{L}_L(V_1,V_2,V_3)
&= - 2 V_1^\mu \ii\partial_\mu V_{2,\nu} V_3^\nu \\
\mathcal{L}_T(V_1,V_2,V_3) - \mathcal{L}_L(V_1,V_2,V_3)
&= 2 V_1^\mu V_{2,\nu} \ii\partial_\mu V_3^\nu
\end{align}
\end{subequations}
As an important example, we can rewrite the dimension-4 ``anomalous'' triple
gauge couplings
\begin{multline}
\ii\mathcal{L}_{\textrm{TGC}}(g_1,\kappa,g_4)/g_{VWW}
= g_1 V^\mu (W^-_{\mu\nu} W^{+,\nu} - W^+_{\mu\nu} W^{-,\nu}) \\
+ \kappa W^+_\mu W^-_\nu V^{\mu\nu}
+ g_4 W^+_\mu W^-_\nu (\partial^\mu V^\nu + \partial^\nu V^\mu)
\end{multline}
as
\begin{multline}
\mathcal{L}_{\textrm{TGC}}(g_1,\kappa,g_4)
= g_1 \mathcal{L}_T(V,W^-,W^+) \\
- \frac{\kappa+g_1-g_4}{2} \mathcal{L}_T(W^-,V,W^+)
+ \frac{\kappa+g_1+g_4}{2} \mathcal{L}_T(W^+,V,W^-) \\
- \frac{\kappa-g_1-g_4}{2} \mathcal{L}_L(W^-,V,W^+)
+ \frac{\kappa-g_1+g_4}{2} \mathcal{L}_L(W^+,V,W^-)
\end{multline}
\thocwmodulesubsection{$CP$ Violation}
\begin{subequations}
\begin{align}
\mathcal{L}_{\tilde T}(V_1,V_2,V_3)
&= V_{1,\mu}(V_{2,\rho}\ii\overleftrightarrow{\partial_\nu}
V_{3,\sigma})\epsilon^{\mu\nu\rho\sigma}
= + \mathcal{L}_T(V_1,V_3,V_2) \\
\mathcal{L}_{\tilde L}(V_1,V_2,V_3)
&= (\ii\partial_\mu V_{1,\nu})
V_{2,\rho}V_{3,\sigma}\epsilon^{\mu\nu\rho\sigma}
= - \mathcal{L}_L(V_1,V_3,V_2)
\end{align}
\end{subequations}
Here the notations~$\tilde T$ and~$\tilde L$ are clearly
\textit{abuse de langage}, because
$\mathcal{L}_{\tilde L}(V_1,V_2,V_3)$ is actually the
transversal combination, due to the antisymmetry of~$\epsilon$.
Using partial integration in~$\mathcal{L}_{\tilde L}$, we could again find
combinations
\begin{subequations}
\begin{align}
\mathcal{L}_{\tilde T}(V_1,V_2,V_3) + \mathcal{L}_{\tilde L}(V_1,V_2,V_3)
&= - 2 V_{1,\mu} V_{2,\nu} \ii\partial_\rho V_{3,\sigma}
\epsilon^{\mu\nu\rho\sigma} \\
\mathcal{L}_{\tilde T}(V_1,V_2,V_3) - \mathcal{L}_{\tilde L}(V_1,V_2,V_3)
&= - 2 V_{1,\mu} \ii\partial_\nu V_{2,\rho} V_{3,\sigma}
\epsilon^{\mu\nu\rho\sigma}
\end{align}
\end{subequations}
but we don't need them, since
\begin{multline}
\ii\mathcal{L}_{\textrm{TGC}}(g_5,\tilde\kappa)/g_{VWW}
= g_5 \epsilon_{\mu\nu\rho\sigma}
(W^{+,\mu} \ii\overleftrightarrow{\partial^\rho} W^{-,\nu}) V^\sigma \\
- \frac{\tilde\kappa_V}{2} W^-_\mu W^+_\nu \epsilon^{\mu\nu\rho\sigma}
V_{\rho\sigma}
\end{multline}
is immediately recognizable as
\begin{equation}
\mathcal{L}_{\textrm{TGC}}(g_5,\tilde\kappa) / g_{VWW}
= - \ii g_5 \mathcal{L}_{\tilde L}(V,W^-,W^+)
+ \tilde\kappa \mathcal{L}_{\tilde T}(V,W^-,W^+)
\end{equation}
%%% #procedure decl
%%% symbol g1, kappa;
%%% vector V, Wp, Wm, k0, kp, km;
%%% vector v, V1, V2, V3, k1, k2, k3;
%%% index mu, nu;
%%% #endprocedure
%%%
%%% #call decl
%%%
%%% global L_T(k1,V1,k2,V2,k3,V3)
%%% = (V1.k2 - V1.k3) * V2.V3;
%%%
%%% global L_L(k1,V1,k2,V2,k3,V3)
%%% = - V1.k1 * V2.V3;
%%%
%%% global L_g1(k1,V1,k2,V2,k3,V3)
%%% = - V1(mu) * ( (k2(mu)*V2(nu) - k2(nu)*V2(mu)) * V3(nu)
%%% - (k3(mu)*V3(nu) - k3(nu)*V3(mu)) * V2(nu) );
%%%
%%% global L_kappa(k1,V1,k2,V2,k3,V3)
%%% = (k1(mu)*V1(nu) - k1(nu)*V1(mu)) * V2(mu) * V3(nu);
%%%
%%% print;
%%% .sort
%%% .store
%%%
%%% #call decl
%%%
%%% local lp = L_T(k1,V1,k2,V2,k3,V3) + L_L(k1,V1,k2,V2,k3,V3);
%%% local lm = L_T(k1,V1,k2,V2,k3,V3) - L_L(k1,V1,k2,V2,k3,V3);
%%% print;
%%% .sort
%%% id k1.v? = - k2.v - k3.v;
%%% print;
%%% .sort
%%% .store
%%%
%%% #call decl
%%%
%%% local [sum(TL)-g1] = - L_g1(k0,V,km,Wm,kp,Wp)
%%% + L_T(k0,V,kp,Wp,km,Wm)
%%% + (L_T(km,Wm,k0,V,kp,Wp) - L_T(kp,Wp,k0,V,km,Wm)) / 2
%%% - (L_L(km,Wm,k0,V,kp,Wp) - L_L(kp,Wp,k0,V,km,Wm)) / 2;
%%%
%%% local [sum(TL)-kappa] = - L_kappa(k0,V,km,Wm,kp,Wp)
%%% + (L_T(km,Wm,k0,V,kp,Wp) - L_T(kp,Wp,k0,V,km,Wm)) / 2
%%% + (L_L(km,Wm,k0,V,kp,Wp) - L_L(kp,Wp,k0,V,km,Wm)) / 2;
%%%
%%% local delta =
%%% - (g1 * L_g1(k0,V,km,Wm,kp,Wp) + kappa * L_kappa(k0,V,km,Wm,kp,Wp))
%%% + g1 * L_T(k0,V,kp,Wp,km,Wm)
%%% + ( g1 + kappa) / 2 * (L_T(km,Wm,k0,V,kp,Wp) - L_T(kp,Wp,k0,V,km,Wm))
%%% + (- g1 + kappa) / 2 * (L_L(km,Wm,k0,V,kp,Wp) - L_L(kp,Wp,k0,V,km,Wm));
%%%
%%% print;
%%% .sort
%%%
%%% id k0.v? = - kp.v - km.v;
%%% print;
%%% .sort
%%% .store
%%%
%%% .end *)
(* \begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.3}
\begin{tabular}{|>{\qquad}r<{:}l|}\hline
\multicolumn{2}{|l|}{[Dim4_Vector_Vector_Vector_T]:
$\mathcal{L}_I=gV_1^\mu
V_{2,\nu}\ii\overleftrightarrow{\partial_\mu}V_3^\nu$}\\\hline
[F23] & $V_1^\mu(k_2+k_3)\leftarrow\ii\cdot
g(k_2^\mu-k_3^\mu)V_{2,\nu}(k_2)V_3^\nu(k_3)$ \\\hline
[F32] & $V_1^\mu(k_2+k_3)\leftarrow\ii\cdot
g(k_2^\mu-k_3^\mu)V_3^\nu(k_3)V_{2,\nu}(k_2)$ \\\hline
[F12] & $V_3^\mu(k_1+k_2)\leftarrow\ii\cdot
g(2k_2^\nu+k_1^\nu)V_{1,\nu}(k_1)V_2^\mu(k_2)$ \\\hline
[F21] & $V_3^\mu(k_1+k_2)\leftarrow\ii\cdot
g(2k_2^\nu+k_1^\nu)V_2^\mu(k_2)V_{1,\nu}(k_1)$ \\\hline
[F13] & $V_2^\mu(k_1+k_3)\leftarrow\ii\cdot
g(-k_1^\nu-2k_3^\nu)V_1^\nu(k_1)V_3^\mu(k_3)$ \\\hline
[F31] & $V_2^\mu(k_1+k_3)\leftarrow\ii\cdot
g(-k_1^\nu-2k_3^\nu)V_3^\mu(k_3)V_1^\nu(k_1)$ \\\hline
\multicolumn{2}{|l|}{[Dim4_Vector_Vector_Vector_L]:
$\mathcal{L}_I=g\ii\partial_\mu V_1^\mu
V_{2,\nu}V_3^\nu$}\\\hline
[F23] & $V_1^\mu(k_2+k_3)\leftarrow\ii\cdot
g(k_2^\mu+k_3^\mu)V_{2,\nu}(k_2)V_3^\nu(k_3)$ \\\hline
[F32] & $V_1^\mu(k_2+k_3)\leftarrow\ii\cdot
g(k_2^\mu+k_3^\mu)V_3^\nu(k_3)V_{2,\nu}(k_2)$ \\\hline
[F12] & $V_3^\mu(k_1+k_2)\leftarrow\ii\cdot
g(-k_1^\nu)V_{1,\nu}(k_1)V_2^\mu(k_2)$ \\\hline
[F21] & $V_3^\mu(k_1+k_2)\leftarrow\ii\cdot
g(-k_1^\nu)V_2^\mu(k_2)V_{1,\nu}(k_1)$ \\\hline
[F13] & $V_2^\mu(k_1+k_3)\leftarrow\ii\cdot
g(-k_1^\nu)V_1^\nu(k_1)V_3^\mu(k_3)$ \\\hline
[F31] & $V_2^\mu(k_1+k_3)\leftarrow\ii\cdot
g(-k_1^\nu)V_3^\mu(k_3)V_1^\nu(k_1)$ \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:dim4-TGC}
\ldots}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.3}
\begin{tabular}{|>{\qquad}r<{:}l|}\hline
\multicolumn{2}{|l|}{[Dim4_Vector_Vector_Vector_T5]:
$\mathcal{L}_I=gV_{1,\mu}
V_{2,\rho}\ii\overleftrightarrow{\partial_\nu}
V_{3,\sigma}\epsilon^{\mu\nu\rho\sigma}$}\\\hline
[F23] & $V_1^\mu(k_2+k_3)\leftarrow\ii\cdot
g\epsilon^{\mu\nu\rho\sigma}(k_{2,\nu}-k_{3,\nu})
V_{2,\rho}(k_2)V_{3,\sigma}(k_3)$ \\\hline
[F32] & $V_1^\mu(k_2+k_3)\leftarrow\ii\cdot
g\epsilon^{\mu\nu\rho\sigma}(k_{2,\nu}-k_{3,\nu})
V_{3,\sigma}(k_3)V_{2,\rho}(k_2)$ \\\hline
[F12] & $V_3^\mu(k_1+k_2)\leftarrow\ii\cdot
g\epsilon^{\mu\nu\rho\sigma}(2k_{2,\nu}+k_{1,\nu})
V_{1,\rho}(k_1)V_{2,\sigma}(k_2)$ \\\hline
[F21] & $V_3^\mu(k_1+k_2)\leftarrow\ii\cdot
g\epsilon^{\mu\nu\rho\sigma}(2k_{2,\nu}+k_{1,\nu})
V_{2,\sigma}(k_2)V_{1,\rho}(k_1)$ \\\hline
[F13] & $V_2^\mu(k_1+k_3)\leftarrow\ii\cdot
g\epsilon^{\mu\nu\rho\sigma}(-k_{1,\nu}-2k_{3,\nu})
V_{1,\rho}(k_1)V_{3,\sigma}(k_3)$ \\\hline
[F31] & $V_2^\mu(k_1+k_3)\leftarrow\ii\cdot
g\epsilon^{\mu\nu\rho\sigma}(-k_{1,\nu}-2k_{3,\nu})
V_{3,\sigma}(k_3)V_{1,\rho}(k_1)$ \\\hline
\multicolumn{2}{|l|}{[Dim4_Vector_Vector_Vector_L5]:
$\mathcal{L}_I=g\ii\partial_\mu V_{1,\nu}
V_{2,\nu}V_{3,\sigma}\epsilon^{\mu\nu\rho\sigma}$}\\\hline
[F23] & $V_1^\mu(k_2+k_3)\leftarrow\ii\cdot
g\epsilon^{\mu\nu\rho\sigma}(k_{2,\nu}+k_{3,\nu})
V_{2,\rho}(k_2)V_{3,\sigma}(k_3)$ \\\hline
[F32] & $V_1^\mu(k_2+k_3)\leftarrow\ii\cdot
g\epsilon^{\mu\nu\rho\sigma}(k_{2,\nu}+k_{3,\nu})
V_{2,\rho}(k_2)V_{3,\sigma}(k_3)$ \\\hline
[F12] & $V_3^\mu(k_1+k_2)\leftarrow\ii\cdot
g\epsilon^{\mu\nu\rho\sigma}(-k_{1,\nu})
V_{1,\rho}(k_1)V_{2,\sigma}(k_2)$ \\\hline
[F21] & $V_3^\mu(k_1+k_2)\leftarrow\ii\cdot
g\epsilon^{\mu\nu\rho\sigma}(-k_{1,\nu})
V_{2,\sigma}(k_2)V_{1,\rho}(k_1)$ \\\hline
[F13] & $V_2^\mu(k_1+k_3)\leftarrow\ii\cdot
g\epsilon^{\mu\nu\rho\sigma}(-k_{1,\nu})
V_{1,\rho}(k_1)V_{3,\sigma}(k_3)$ \\\hline
[F31] & $V_2^\mu(k_1+k_3)\leftarrow\ii\cdot
g\epsilon^{\mu\nu\rho\sigma}(-k_{1,\nu})
V_{3,\sigma}(k_3)V_{1,\rho}(k_1)$ \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:dim4-TGC5}
\ldots}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.3}
\begin{tabular}{|>{\qquad}r<{:}l|}\hline
\multicolumn{2}{|l|}{[Dim6_Gauge_Gauge_Gauge]:
$\mathcal{L}_I=gF_1^{\mu\nu}F_{2,\nu\rho}
F_{3,\hphantom{\rho}\mu}^{\hphantom{3,}\rho}$}\\\hline
[_] & $A_1^\mu(k_2+k_3)\leftarrow-\ii\cdot
\Lambda^{\mu\rho\sigma}(-k_2-k_3,k_2,k_3)
A_{2,\rho} A_{c,\sigma}$\\\hline
\end{tabular}
\end{center}
\caption{\label{tab:dim6-TGC}
\ldots}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.3}
\begin{tabular}{|>{\qquad}r<{:}l|}\hline
\multicolumn{2}{|l|}{[Dim6_Gauge_Gauge_Gauge_5]:
$\mathcal{L}_I=g/2\cdot\epsilon^{\mu\nu\lambda\tau}
F_{1,\mu\nu}F_{2,\tau\rho}
F_{3,\hphantom{\rho}\lambda}^{\hphantom{3,}\rho}$}\\\hline
[F23] & $A_1^\mu(k_2+k_3)\leftarrow-\ii\cdot
\Lambda_5^{\mu\rho\sigma}(-k_2-k_3,k_2,k_3)
A_{2,\rho} A_{3,\sigma}$\\\hline
[F32] & $A_1^\mu(k_2+k_3)\leftarrow-\ii\cdot
\Lambda_5^{\mu\rho\sigma}(-k_2-k_3,k_2,k_3)
A_{3,\sigma} A_{2,\rho}$\\\hline
[F12] & $A_3^\mu(k_1+k_2)\leftarrow-\ii\cdot$\\\hline
[F21] & $A_3^\mu(k_1+k_2)\leftarrow-\ii\cdot$\\\hline
[F13] & $A_2^\mu(k_1+k_3)\leftarrow-\ii\cdot$\\\hline
[F31] & $A_2^\mu(k_1+k_3)\leftarrow-\ii\cdot$\\\hline
\end{tabular}
\end{center}
\caption{\label{tab:dim6-TGC5}
\ldots}
\end{table} *)
(* \thocwmodulesection{$\textrm{SU}(2)$ Gauge Bosons}
An important special case for table~\ref{tab:dim4-bosons} are the two
usual coordinates of~$\textrm{SU}(2)$
\begin{equation}
W_\pm = \frac{1}{\sqrt2} \left(W_1 \mp \ii W_2\right)
\end{equation}
i.\,e.
\begin{subequations}
\begin{align}
W_1 &= \frac{1}{\sqrt2} \left(W_+ + W_-\right) \\
W_2 &= \frac{\ii}{\sqrt2} \left(W_+ - W_-\right)
\end{align}
\end{subequations}
and
\begin{equation}
W_1^\mu W_2^\nu - W_2^\mu W_1^\nu
= \ii\left(W_-^\mu W_+^\nu - W_+^\mu W_-^\nu\right)
\end{equation}
Thus the symmtry remains after the change of basis:
\begin{multline}
\epsilon^{abc} W_a^{\mu_1}W_b^{\mu_2}W_c^{\mu_3}
= \ii W_-^{\mu_1} (W_+^{\mu_2}W_3^{\mu_3} - W_3^{\mu_2}W_+^{\mu_3}) \\
+ \ii W_+^{\mu_1} (W_3^{\mu_2}W_-^{\mu_3} - W_-^{\mu_2}W_3^{\mu_3})
+ \ii W_3^{\mu_1} (W_-^{\mu_2}W_+^{\mu_3} - W_+^{\mu_2}W_-^{\mu_3})
\end{multline} *)
(* \thocwmodulesection{Quartic Couplings and Auxiliary Fields}
Quartic couplings can be replaced by cubic couplings to a non-propagating
auxiliary field. The quartic term should get a negative sign so that it the
energy is bounded from below for identical fields. In the language of
functional integrals
\begin{subequations}
\label{eq:quartic-aux}
\begin{multline}
\mathcal{L}_{\phi^4} = - g^2\phi_1\phi_2\phi_3\phi_4
\Longrightarrow \\
\mathcal{L}_{X\phi^2}
= X^*X \pm gX\phi_1\phi_2 \pm gX^*\phi_3\phi_4
= (X^* \pm g\phi_1\phi_2)(X \pm g\phi_3\phi_4)
- g^2\phi_1\phi_2\phi_3\phi_4
\end{multline}
and in the language of Feynman diagrams
\begin{equation}
\parbox{21mm}{\begin{fmfgraph*}(20,20)
\fmfleft{e1,e2}
\fmfright{e3,e4}
\fmf{plain}{v,e1}
\fmf{plain}{v,e2}
\fmf{plain}{v,e3}
\fmf{plain}{v,e4}
\fmfv{d.sh=circle,d.si=dot_size,label=$-\ii g^2$}{v}
\end{fmfgraph*}}
\qquad\Longrightarrow\qquad
\parbox{21mm}{\begin{fmfgraph*}(20,20)
\fmfleft{e1,e2}
\fmfright{e3,e4}
\fmf{plain}{v12,e1}
\fmf{plain}{v12,e2}
\fmf{plain}{v34,e3}
\fmf{plain}{v34,e4}
\fmf{dashes,label=$+\ii$}{v12,v34}
\fmfv{d.sh=circle,d.si=dot_size,label=$\pm\ii g$}{v12}
\fmfv{d.sh=circle,d.si=dot_size,label=$\pm\ii g$}{v34}
\end{fmfgraph*}}
\end{equation}
\end{subequations}
The other choice of signs
\begin{equation}
\mathcal{L}_{X\phi^2}'
= - X^*X \pm gX\phi_1\phi_2 \mp gX^*\phi_3\phi_4
= - (X^* \pm g\phi_1\phi_2)(X \mp g\phi_3\phi_4)
- g^2\phi_1\phi_2\phi_3\phi_4
\end{equation}
can not be extended easily to identical particles and is therefore
not used. For identical particles we have
\begin{multline}
\mathcal{L}_{\phi^4} = - \frac{g^2}{4!}\phi^4
\Longrightarrow \\
\mathcal{L}_{X\phi^2}
= \frac{1}{2}X^2 \pm \frac{g}{2}X\phi^2 \pm \frac{g}{2}X\phi^2
= \frac{1}{2}\left(X \pm \frac{g}{2}\phi^2\right)
\left(X \pm \frac{g}{2}\phi^2\right)
- \frac{g^2}{4!}\phi^4
\end{multline}
\begin{dubious}
Explain the factor~$1/3$ in the functional setting and its
relation to the three diagrams in the graphical setting?
\end{dubious}
\thocwmodulesubsection{Quartic Gauge Couplings}
\begin{figure}
\begin{subequations}
\label{eq:Feynman-QCD}
\begin{align}
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,24)
\threeexternal{k,,\mu,,a}{p}{p'}
\fmf{gluon}{v,e1}
\fmf{fermion}{e2,v,e3}
\fmfdot{v} \end{fmfgraph*}}} \,&=
\begin{split}
\mbox{} + & \ii g\gamma_\mu T_a
\end{split} \\
\label{eq:TGV}
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,24)
\threeexternal{1}{2}{3}
\fmf{gluon}{v,e1}
\fmf{gluon}{v,e2}
\fmf{gluon}{v,e3}
\threeoutgoing
\end{fmfgraph*}}} \,&=
\begin{split}
& g f_{a_1a_2a_3} C^{\mu_1\mu_2\mu_3} (k_1,k_2,k_3)
\end{split} \\
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,24)
\fmfsurround{d1,e1,d2,e2,d3,e3,d4,e4}
\fmf{gluon}{v,e1}
\fmf{gluon}{v,e2}
\fmf{gluon}{v,e3}
\fmf{gluon}{v,e4}
\fmflabel{1}{e1}
\fmflabel{2}{e2}
\fmflabel{3}{e3}
\fmflabel{4}{e4}
\fmfdot{v}
\fmffreeze
\fmf{warrow_right}{v,e1}
\fmf{warrow_right}{v,e2}
\fmf{warrow_right}{v,e3}
\fmf{warrow_right}{v,e4}
\end{fmfgraph*}}} \,&=
\begin{split}
\mbox{} - & \ii g^2 f_{a_1a_2b}f_{a_3a_4b}
(g_{\mu_1\mu_3} g_{\mu_4\mu_2} - g_{\mu_1\mu_4} g_{\mu_2\mu_3}) \\
\mbox{} - & \ii g^2 f_{a_1a_3b}f_{a_4a_2b}
(g_{\mu_1\mu_4} g_{\mu_2\mu_3} - g_{\mu_1\mu_2} g_{\mu_3\mu_4}) \\
\mbox{} - & \ii g^2 f_{a_1a_4b}f_{a_2a_3b}
(g_{\mu_1\mu_2} g_{\mu_3\mu_4} - g_{\mu_1\mu_3} g_{\mu_4\mu_2})
\end{split}
\end{align}
\end{subequations}
\caption{\label{fig:gauge-feynman-rules} Gauge couplings.
See~(\ref{eq:C123}) for the definition of the antisymmetric
tensor $C^{\mu_1\mu_2\mu_3}(k_1,k_2,k_3)$.}
\end{figure}
\begin{figure}
\begin{equation}
\label{eq:Feynman-QCD'}
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,24)
\fmfsurround{d1,e1,d2,e2,d3,e3,d4,e4}
\fmf{gluon}{v12,e1}
\fmf{gluon}{v12,e2}
\fmf{gluon}{v34,e3}
\fmf{gluon}{v34,e4}
\fmf{dashes}{v12,v34}
\fmflabel{1}{e1}
\fmflabel{2}{e2}
\fmflabel{3}{e3}
\fmflabel{4}{e4}
\fmfdot{v12,v34}
\fmffreeze
\fmf{warrow_right}{v12,e1}
\fmf{warrow_right}{v12,e2}
\fmf{warrow_right}{v34,e3}
\fmf{warrow_right}{v34,e4}
\end{fmfgraph*}}} \,=
\mbox{} - \ii g^2 f_{a_1a_2b}f_{a_3a_4b}
(g_{\mu_1\mu_3} g_{\mu_4\mu_2} - g_{\mu_1\mu_4} g_{\mu_2\mu_3})
\end{equation}
\caption{\label{fig:gauge-feynman-rules'} Gauge couplings.}
\end{figure}
The three crossed versions of
figure~\ref{fig:gauge-feynman-rules'} reproduces the quartic coupling in
figure~\ref{fig:gauge-feynman-rules}, because
\begin{multline}
- \ii g^2 f_{a_1a_2b}f_{a_3a_4b}
(g_{\mu_1\mu_3} g_{\mu_4\mu_2} - g_{\mu_1\mu_4} g_{\mu_2\mu_3}) \\
= (\ii g f_{a_1a_2b} T_{\mu_1\mu_2,\nu_1\nu_2})
\left(\frac{\ii g^{\nu_1\nu_3} g^{\nu_2\nu_4}}{2}\right)
(\ii g f_{a_3a_4b} T_{\mu_3\mu_4,\nu_3\nu_4})
\end{multline}
with $T_{\mu_1\mu_2,\mu_3\mu_4} =
g_{\mu_1\mu_3}g_{\mu_4\mu_2}-g_{\mu_1\mu_4}g_{\mu_2\mu_3}$. *)
(* \thocwmodulesection{Gravitinos and supersymmetric currents}
In supergravity theories there is a fermionic partner of the graviton, the
gravitino. Therefore we have introduced the Lorentz type [Vectorspinor].
*)
(* \begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.4}
\begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline
\multicolumn{4}{|l|}{[GBG (Fermbar, MOM, Ferm)]:
$\bar\psi_1(\ii\fmslash{\partial}\pm m)\phi\psi_2$}\\\hline
[F12] & $\psi_2\leftarrow-(\fmslash{k}\mp m)\psi_1S$
& [F21] & $\psi_2\leftarrow-S(\fmslash{k}\mp m)\psi_1$ \\\hline
[F13] & $S\leftarrow \psi^T_1 {\rm C}(\fmslash{k}\pm m)\psi_2$
& [F31] & $S\leftarrow \psi^T_2 {\rm C}(-(\fmslash{k}\mp m)\psi_1)$ \\\hline
[F23] & $\psi_1\leftarrow S(\fmslash{k}\pm m)\psi_2$
& [F32] & $\psi_1\leftarrow(\fmslash{k}\pm m)\psi_2 S$ \\\hline
\multicolumn{4}{|l|}{[GBG (Fermbar, MOM5, Ferm)]:
$\bar\psi_1(\ii\fmslash{\partial}\pm m)\phi\gamma^5\psi_2$}\\\hline
[F12] & $\psi_2\leftarrow(\fmslash{k}\pm m)\gamma^5\psi_1P$
& [F21] & $\psi_2\leftarrow P(\fmslash{k}\pm m)\gamma^5\psi_1$ \\\hline
[F13] & $P\leftarrow \psi^T_1 {\rm C}(\fmslash{k}\pm m)\gamma^5\psi_2$
& [F31] & $P\leftarrow \psi^T_2 {\rm C}(\fmslash{k}\pm m)\gamma^5\psi_1$ \\\hline
[F23] & $\psi_1\leftarrow P(\fmslash{k}\pm m)\gamma^5\psi_2$
& [F32] & $\psi_1\leftarrow(\fmslash{k}\pm m)\gamma^5\psi_2 P$ \\\hline
\multicolumn{4}{|l|}{[GBG (Fermbar, MOML, Ferm)]:
$\bar\psi_1 (\ii\fmslash{\partial}\pm m)\phi(1-\gamma^5)\psi_2$}\\\hline
[F12] & $\psi_2\leftarrow-(1-\gamma^5)(\fmslash{k}\mp m)\psi_1\phi$
& [F21] & $\psi_2\leftarrow-\phi(1-\gamma^5)(\fmslash{k}\mp m)\psi_1$ \\\hline
[F13] & $\phi\leftarrow \psi^T_1 {\rm C}(\fmslash{k}\pm m)(1-\gamma^5)\psi_2$
& [F31] & $\phi\leftarrow \psi^T_2 {\rm C}(1-\gamma^5)(-(\fmslash{k}\mp m)\psi_1)$ \\\hline
[F23] & $\psi_1\leftarrow\phi(\fmslash{k}\pm m)(1-\gamma^5)\psi_2$
& [F32] & $\psi_1\leftarrow(\fmslash{k}\pm m)(1-\gamma^5)\psi_2 \phi$ \\\hline
\multicolumn{4}{|l|}{[GBG (Fermbar, LMOM, Ferm)]:
$\bar\psi_1 \phi(1-\gamma^5)(\ii\fmslash{\partial}\pm m)\psi_2$}\\\hline
[F12] & $\psi_2\leftarrow-(\fmslash{k}\mp m)\psi_1(1-\gamma^5)\phi$
& [F21] & $\psi_2\leftarrow-\phi(\fmslash{k}\mp m)(1-\gamma^5)\psi_1$ \\\hline
[F13] & $\phi\leftarrow \psi^T_1 {\rm C}(1-\gamma^5)(\fmslash{k}\pm m)\psi_2$
& [F31] & $\phi\leftarrow \psi^T_2 {\rm C}(-(\fmslash{k}\mp m)(1-\gamma^5)\psi_1)$ \\\hline
[F23] & $\psi_1\leftarrow\phi(1-\gamma^5)(\fmslash{k}\pm m)\psi_2$
& [F32] & $\psi_1\leftarrow(1-\gamma^5)(\fmslash{k}\pm m)\psi_2 \phi$ \\\hline
\multicolumn{4}{|l|}{[GBG (Fermbar, VMOM, Ferm)]:
$\bar\psi_1 \ii\fmslash{\partial}_\alpha V_\beta \lbrack \gamma^\alpha, \gamma^\beta \rbrack \psi_2$}\\\hline
[F12] & $\psi_2\leftarrow-\lbrack\fmslash{k},\gamma^\alpha\rbrack\psi_1 V_\alpha$
& [F21] & $\psi_2\leftarrow-\lbrack\fmslash{k},\fmslash{V}\rbrack\psi_1$ \\\hline
[F13] & $V_\alpha\leftarrow \psi^T_1 {\rm C}\lbrack\fmslash{k},\gamma_\alpha\rbrack\psi_2$
& [F31] & $V_\alpha\leftarrow \psi^T_2 {\rm C}(-\lbrack\fmslash{k}, \gamma_\alpha\rbrack\psi_1)$ \\\hline
[F23] & $\psi_1\leftarrow\rbrack\fmslash{k},\fmslash{V}\rbrack\psi_2$
& [F32] & $\psi_1\leftarrow\lbrack\fmslash{k},\gamma^\alpha\rbrack\psi_2 V_\alpha$ \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:dim4-fermions-MOM} Combined dimension-4 trilinear
fermionic couplings including a momentum. $Ferm$ stands for $Psi$ and
$Chi$. The case of $MOMR$ is identical to $MOML$ if one substitutes
$1+\gamma^5$ for $1-\gamma^5$, as well as for $LMOM$ and $RMOM$. The
mass term forces us to keep the chiral projector always on the left
after "inverting the line" for $MOML$ while on the right for $LMOM$.}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.4}
\begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline
\multicolumn{2}{|l|}{[GBBG (Fermbar, S2LR, Ferm)]: $\bar\psi_1 S_1 S_2
(g_L P_L + g_R P_R) \psi_2$}\\\hline
[F123] [F213] [F132] [F231] [F312] [F321] & $\psi_2\leftarrow S_1 S_2 (g_R P_L + g_L P_R) \psi_1$ \\ \hline
[F423] [F243] [F432] [F234] [F342] [F324] & $\psi_1 \leftarrow S_1 S_2 (g_L P_L + g_R P_R) \psi_2$ \\ \hline
[F134] [F143] [F314] & $S_1 \leftarrow \psi^T_1 C S_2 (g_L P_L + g_R P_R) \psi_2$ \\ \hline
[F124] [F142] [F214] & $S_2 \leftarrow \psi^T_1 C S_1 (g_L P_L + g_R P_R) \psi_2$ \\ \hline
[F413] [F431] [F341] & $S_1 \leftarrow \psi^T_2 C S_2 (g_R P_L + g_L P_R) \psi_1$ \\ \hline
[F412] [F421] [F241] & $S_2 \leftarrow \psi^T_2 C S_1 (g_R P_L + g_L P_R) \psi_1$ \\ \hline
\multicolumn{2}{|l|}{[GBBG (Fermbar, S2, Ferm)]: $\bar\psi_1 S_1 S_2
\gamma^5 \psi_2$}\\\hline
[F123] [F213] [F132] [F231] [F312] [F321] & $\psi_2\leftarrow S_1 S_2 \gamma^5 \psi_1$ \\ \hline
[F423] [F243] [F432] [F234] [F342] [F324] & $\psi_1 \leftarrow S_1 S_2 \gamma^5 \psi_2$ \\ \hline
[F134] [F143] [F314] & $S_1 \leftarrow \psi^T_1 C S_2 \gamma^5 \psi_2$ \\ \hline
[F124] [F142] [F214] & $S_2 \leftarrow \psi^T_1 C S_1 \gamma^5 \psi_2$ \\ \hline
[F413] [F431] [F341] & $S_1 \leftarrow \psi^T_2 C S_2 \gamma^5 \psi_1$ \\ \hline
[F412] [F421] [F241] & $S_2 \leftarrow \psi^T_2 C S_1 \gamma^5 \psi_1$ \\ \hline
\multicolumn{2}{|l|}{[GBBG (Fermbar, V2, Ferm)]: $\bar\psi_1 \lbrack \fmslash{V}_1 , \fmslash{V}_2 \rbrack \psi_2$}\\\hline
[F123] [F213] [F132] [F231] [F312] [F321] & $\psi_2\leftarrow - \lbrack \fmslash{V}_1 , \fmslash{V}_2 \rbrack \psi_1$ \\ \hline
[F423] [F243] [F432] [F234] [F342] [F324] & $\psi_1 \leftarrow \lbrack \fmslash{V}_1 , \fmslash{V}_2 \rbrack \psi_2$ \\ \hline
[F134] [F143] [F314] & $V_{1\:\alpha} \leftarrow \psi^T_1 C \lbrack \gamma_\alpha , \fmslash{V}_2 \rbrack \psi_2$ \\ \hline
[F124] [F142] [F214] & $V_{2\:\alpha} \leftarrow \psi^T_1 C (-\lbrack \gamma_\alpha , \fmslash{V}_1 \rbrack) \psi_2$ \\ \hline
[F413] [F431] [F341] & $V_{1\:\alpha} \leftarrow \psi^T_2 C (-\lbrack \gamma_\alpha , \fmslash{V}_2 \rbrack) \psi_1$ \\ \hline
[F412] [F421] [F241] & $V_{2\:\alpha} \leftarrow \psi^T_2 C \lbrack \gamma_\alpha , \fmslash{V}_1 \rbrack \psi_1$ \\ \hline
\end{tabular}
\end{center}
\caption{\label{tab:dim5-mom2} Vertices with two fermions ($Ferm$ stands
for $Psi$ and $Chi$, but not for $Grav$) and two bosons (two scalars,
scalar/vector, two vectors) for the BRST transformations. Part I}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.4}
\begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline
\multicolumn{2}{|l|}{[GBBG (Fermbar, SV, Ferm)]: $\bar\psi_1 \fmslash{V} S \psi_2$}\\\hline
[F123] [F213] [F132] [F231] [F312] [F321] & $\psi_2\leftarrow - \fmslash{V} S \psi_1$ \\ \hline
[F423] [F243] [F432] [F234] [F342] [F324] & $\psi_1 \leftarrow \fmslash{V} S \psi_2$ \\ \hline
[F134] [F143] [F314] & $V_\alpha \leftarrow \psi^T_1 C \gamma_\alpha S \psi_2$ \\ \hline
[F124] [F142] [F214] & $S \leftarrow \psi^T_1 C \fmslash{V} \psi_2$ \\ \hline
[F413] [F431] [F341] & $V_\alpha \leftarrow \psi^T_2 C (- \gamma_\alpha S \psi_1)$ \\ \hline
[F412] [F421] [F241] & $S \leftarrow \psi^T_2 C (- \fmslash{V} \psi_1)$ \\ \hline
\multicolumn{2}{|l|}{[GBBG (Fermbar, PV, Ferm)]: $\bar\psi_1 \fmslash{V} \gamma^5 P \psi_2$}\\\hline
[F123] [F213] [F132] [F231] [F312] [F321] & $\psi_2\leftarrow \fmslash{V} \gamma^5 P \psi_1$ \\ \hline
[F423] [F243] [F432] [F234] [F342] [F324] & $\psi_1 \leftarrow \fmslash{V} \gamma^5 P \psi_2$ \\ \hline
[F134] [F143] [F314] & $V_\alpha \leftarrow \psi^T_1 C \gamma_\alpha \gamma^5 P \psi_2$ \\ \hline
[F124] [F142] [F214] & $P \leftarrow \psi^T_1 C \fmslash{V} \gamma^5 \psi_2$ \\ \hline
[F413] [F431] [F341] & $V_\alpha \leftarrow \psi^T_2 C \gamma_\alpha \gamma^5 P \psi_1$ \\ \hline
[F412] [F421] [F241] & $P \leftarrow \psi^T_2 C \fmslash{V} \gamma^5 \psi_1$ \\ \hline
\multicolumn{2}{|l|}{[GBBG (Fermbar, S(L/R)V, Ferm)]: $\bar\psi_1 \fmslash{V} (1 \mp\gamma^5) \phi \psi_2$}\\\hline
[F123] [F213] [F132] [F231] [F312] [F321] & $\psi_2\leftarrow - \fmslash{V} (1\pm\gamma^5) \phi \psi_1$ \\ \hline
[F423] [F243] [F432] [F234] [F342] [F324] & $\psi_1 \leftarrow \fmslash{V} (1\mp\gamma^5) \phi \psi_2$ \\ \hline
[F134] [F143] [F314] & $V_\alpha \leftarrow \psi^T_1 C \gamma_\alpha (1\mp\gamma^5) \phi \psi_2$ \\ \hline
[F124] [F142] [F214] & $\phi \leftarrow \psi^T_1 C \fmslash{V} (1\mp\gamma^5) \psi_2$ \\ \hline
[F413] [F431] [F341] & $V_\alpha \leftarrow \psi^T_2 C \gamma_\alpha (-(1\pm\gamma^5) \phi \psi_1)$ \\ \hline
[F412] [F421] [F241] & $\phi \leftarrow \psi^T_2 C \fmslash{V} (-(1\pm\gamma^5) \psi_1)$ \\ \hline
\end{tabular}
\end{center}
\caption{\label{tab:dim5-mom2} Vertices with two fermions ($Ferm$ stands
for $Psi$ and $Chi$, but not for $Grav$) and two bosons (two scalars,
scalar/vector, two vectors) for the BRST transformations. Part II}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.4}
\begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline
\multicolumn{4}{|l|}{[GBG (Gravbar, POT, Psi)]: $\bar\psi_\mu S \gamma^\mu \psi$}\\\hline
[F12] & $\psi\leftarrow - \gamma^\mu \psi_\mu S$
& [F21] & $\psi\leftarrow - S\gamma^\mu \psi_\mu$ \\\hline
[F13] & $S\leftarrow \psi^T_\mu {\rm C} \gamma^\mu \psi$
& [F31] & $S\leftarrow \psi^T{\rm C} (-\gamma^\mu)\psi_\mu$ \\\hline
[F23] & $\psi_\mu\leftarrow S\gamma_\mu\psi$
& [F32] & $\psi_\mu\leftarrow \gamma_\mu \psi S$ \\\hline
\multicolumn{4}{|l|}{[GBG (Gravbar, S, Psi)]: $\bar\psi_\mu \fmslash{k}_S S \gamma^\mu \psi$}\\\hline
[F12] & $\psi\leftarrow \gamma^\mu \fmslash{k}_S \psi_\mu S$
& [F21] & $\psi\leftarrow S\gamma^\mu \fmslash{k}_S \psi_\mu$ \\\hline
[F13] & $S\leftarrow \psi^T_\mu {\rm C} \fmslash{k}_S \gamma^\mu \psi$
& [F31] & $S\leftarrow \psi^T{\rm C}\gamma^\mu\fmslash{k}_S \psi_\mu$ \\\hline
[F23] & $\psi_\mu\leftarrow S\fmslash{k}_S\gamma_\mu\psi$
& [F32] & $\psi_\mu\leftarrow \fmslash{k}_S \gamma_\mu \psi S$ \\\hline
\multicolumn{4}{|l|}{[GBG (Gravbar, P, Psi)]: $\bar\psi_\mu \fmslash{k}_P P \gamma^\mu \gamma_5 \psi$}\\\hline
[F12] & $\psi\leftarrow \gamma^\mu\fmslash{k}_P\gamma_5\psi_\mu P$
& [F21] & $\psi\leftarrow P\gamma^\mu\fmslash{k}_P\gamma_5\psi_\mu$ \\\hline
[F13] & $P\leftarrow \psi^T_\mu {\rm C}\fmslash{k}_P\gamma^\mu\gamma_5\psi$
& [F31] & $P\leftarrow \psi^T {\rm C}\gamma^\mu\fmslash{k}_P\gamma_5\psi_\mu$ \\\hline
[F23] & $\psi_\mu\leftarrow P\fmslash{k}_P \gamma_\mu \gamma_5 \psi$
& [F32] & $\psi_\mu\leftarrow \fmslash{k}_P \gamma_\mu \gamma_5 \psi P$ \\\hline
\multicolumn{4}{|l|}{[GBG (Gravbar, V, Psi)]: $\bar\psi_\mu\lbrack\fmslash{k}_V,\fmslash{V}\rbrack\gamma^\mu\gamma^5\psi$}\\\hline
[F12] & $\psi\leftarrow \gamma^5\gamma^\mu \lbrack \fmslash{k}_V , \gamma^\alpha \rbrack \psi_\mu V_\alpha$
& [F21] & $\psi\leftarrow \gamma^5\gamma^\mu \lbrack \fmslash{k}_V , \fmslash{V} \rbrack\psi_\mu$ \\\hline
[F13] & $V_{\mu}\leftarrow \psi^T_\rho {\rm C} \lbrack \fmslash{k}_V , \gamma_\mu \rbrack \gamma^\rho \gamma^5 \psi$
& [F31] & $V_{\mu}\leftarrow \psi^T {\rm C} \gamma^5 \gamma^{\rho} \lbrack \fmslash{k}_V , \gamma_\mu \rbrack \psi_\rho$ \\\hline
[F23] & $\psi_\mu\leftarrow\lbrack \fmslash{k}_V , \fmslash{V} \rbrack \gamma_\mu \gamma^5 \psi $
& [F32] & $\psi_\mu\leftarrow\lbrack \fmslash{k}_V , \gamma^\alpha \rbrack \gamma_\mu \gamma^5 \psi V_\alpha$ \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:dim5-fermions-gravdirac} Dimension-5 trilinear
couplings including one Dirac, one Gravitino fermion and one additional particle.The option [POT] is for the coupling of the supersymmetric current to the derivative of the quadratic terms in the superpotential.}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.4}
\begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline
\multicolumn{4}{|l|}{[GBG (Psibar, POT, Grav)]: $\bar\psi \gamma^\mu S \psi_\mu$}\\\hline
[F12] & $\psi_\mu\leftarrow - \gamma_\mu \psi S$
& [F21] & $\psi_\mu\leftarrow - S \gamma_\mu\psi$ \\\hline
[F13] & $S\leftarrow \psi^T{\rm C}\gamma^\mu\psi_\mu$
& [F31] & $S\leftarrow \psi^T_\mu {\rm C} (-\gamma^\mu) \psi$ \\\hline
[F23] & $\psi\leftarrow S\gamma^\mu\psi_\mu$
& [F32] & $\psi\leftarrow \gamma^\mu\psi_\mu S$ \\\hline
\multicolumn{4}{|l|}{[GBG (Psibar, S, Grav)]: $\bar\psi \gamma^\mu \fmslash{k}_S S \psi_\mu$}\\\hline
[F12] & $\psi_\mu\leftarrow \fmslash{k}_S \gamma_\mu \psi S$
& [F21] & $\psi_\mu\leftarrow S \fmslash{k}_S \gamma_\mu\psi$ \\\hline
[F13] & $S\leftarrow \psi^T{\rm C}\gamma^\mu\fmslash{k}_S \psi_\mu$
& [F31] & $S\leftarrow \psi^T_\mu {\rm C} \fmslash{k}_S \gamma^\mu \psi$ \\\hline
[F23] & $\psi\leftarrow S\gamma^\mu\fmslash{k}_S\psi_\mu$
& [F32] & $\psi\leftarrow \gamma^\mu\fmslash{k}_S\psi_\mu S$ \\\hline
\multicolumn{4}{|l|}{[GBG (Psibar, P, Grav)]: $\bar\psi \gamma^\mu\gamma^5 P\fmslash{k}_P \psi_\mu$}\\\hline
[F12] & $\psi_\mu\leftarrow -\fmslash{k}_P \gamma_\mu \gamma^5 \psi P$
& [F21] & $\psi_\mu\leftarrow -P\fmslash{k}_P \gamma_\mu \gamma^5 \psi$ \\\hline
[F13] & $P\leftarrow \psi^T {\rm C}\gamma^\mu\gamma^5\fmslash{k}_P\psi_\mu$
& [F31] & $P\leftarrow -\psi^T_\mu {\rm C}\fmslash{k}_P\gamma^\mu\gamma_5\psi$ \\\hline
[F23] & $\psi\leftarrow P \gamma^\mu\gamma^5\fmslash{k}_P\psi_\mu$
& [F32] & $\psi\leftarrow \gamma^\mu\gamma^5\fmslash{k}_P\psi_\mu P$ \\\hline
\multicolumn{4}{|l|}{[GBG (Psibar, V, Grav)]: $\bar\psi\gamma^5\gamma^\mu\lbrack\fmslash{k}_V,\fmslash{V}\rbrack\psi_\mu$}\\\hline
[F12] & $\psi_\mu\leftarrow \lbrack \fmslash{k}_V , \gamma^\alpha \rbrack \gamma_\mu \gamma^5 \psi V_\alpha$
& [F21] & $\psi_\mu\leftarrow \lbrack \fmslash{k}_V , \fmslash{V} \rbrack \gamma_\mu \gamma^5 \psi$ \\\hline
[F13] & $V_{\mu}\leftarrow \psi^T {\rm C} \gamma^5 \gamma^\rho \lbrack \fmslash{k}_V , \gamma_\mu \rbrack \psi_\rho$
& [F31] & $V_{\mu}\leftarrow \psi^T_\rho {\rm C} \lbrack \fmslash{k}_V , \gamma_\mu \rbrack \gamma^\rho \gamma^5 \psi$ \\\hline
[F23] & $\psi\leftarrow\gamma^5\gamma^\mu\lbrack \fmslash{k}_V , \fmslash{V} \rbrack\psi_\mu$
& [F32] & $\psi\leftarrow\gamma^5\gamma^\mu\lbrack \fmslash{k}_V , \gamma^\alpha \rbrack\psi_\mu V_\alpha$ \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:dim5-fermions-diracgrav} Dimension-5 trilinear
couplings including one conjugated Dirac, one Gravitino fermion and one additional particle.}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.4}
\begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline
\multicolumn{4}{|l|}{[GBG (Gravbar, POT, Chi)]: $\bar\psi_\mu S \gamma^\mu \chi$}\\\hline
[F12] & $\chi\leftarrow - \gamma^\mu \psi_\mu S$
& [F21] & $\chi\leftarrow - S\gamma^\mu \psi_\mu$ \\\hline
[F13] & $S\leftarrow \psi^T_\mu {\rm C} \gamma^\mu \chi$
& [F31] & $S\leftarrow \chi^T{\rm C} (-\gamma^\mu)\psi_\mu$ \\\hline
[F23] & $\psi_\mu\leftarrow S\gamma_\mu\chi$
& [F32] & $\psi_\mu\leftarrow \gamma_\mu \chi S$ \\\hline
\multicolumn{4}{|l|}{[GBG (Gravbar, S, Chi)]: $\bar\psi_\mu \fmslash{k}_S S \gamma^\mu \chi$}\\\hline
[F12] & $\chi\leftarrow \gamma^\mu \fmslash{k}_S \psi_\mu S$
& [F21] & $\chi\leftarrow S\gamma^\mu \fmslash{k}_S \psi_\mu$ \\\hline
[F13] & $S\leftarrow \psi^T_\mu {\rm C} \fmslash{k}_S \gamma^\mu \chi$
& [F31] & $S\leftarrow \chi^T{\rm C}\gamma^\mu\fmslash{k}_S \psi_\mu$ \\\hline
[F23] & $\psi_\mu\leftarrow S\fmslash{k}_S\gamma_\mu\chi$
& [F32] & $\psi_\mu\leftarrow \fmslash{k}_S \gamma_\mu \chi S$ \\\hline
\multicolumn{4}{|l|}{[GBG (Gravbar, P, Chi)]: $\bar\psi_\mu \fmslash{k}_P P \gamma^\mu \gamma_5 \chi$}\\\hline
[F12] & $\chi\leftarrow \gamma^\mu\fmslash{k}_P\gamma_5\psi_\mu P$
& [F21] & $\chi\leftarrow P\gamma^\mu\fmslash{k}_P\gamma_5\psi_\mu$ \\\hline
[F13] & $P\leftarrow \psi^T_\mu {\rm C}\fmslash{k}_P\gamma^\mu\gamma_5\chi$
& [F31] & $P\leftarrow \chi^T {\rm C}\gamma^\mu\fmslash{k}_P\gamma_5\psi_\mu$ \\\hline
[F23] & $\psi_\mu\leftarrow P\fmslash{k}_P \gamma_\mu \gamma_5 \chi$
& [F32] & $\psi_\mu\leftarrow \fmslash{k}_P \gamma_\mu \gamma_5 \chi P$ \\\hline
\multicolumn{4}{|l|}{[GBG (Gravbar, V, Chi)]: $\bar\psi_\mu\lbrack\fmslash{k}_V,\fmslash{V}\rbrack\gamma^\mu\gamma^5\chi$}\\\hline
[F12] & $\chi\leftarrow \gamma^5\gamma^\mu \lbrack \fmslash{k}_V , \gamma^\alpha \rbrack \psi_\mu V_\alpha$
& [F21] & $\chi\leftarrow \gamma^5\gamma^\mu \lbrack \fmslash{k}_V , \fmslash{V} \rbrack\psi_\mu$ \\\hline
[F13] & $V_{\mu}\leftarrow \psi^T_\rho {\rm C} \lbrack \fmslash{k}_V , \gamma_\mu \rbrack \gamma^\rho \gamma^5 \chi$
& [F31] & $V_{\mu}\leftarrow \chi^T {\rm C} \gamma^5 \gamma^{\rho} \lbrack \fmslash{k}_V , \gamma_\mu \rbrack \psi_\rho$ \\\hline
[F23] & $\psi_\mu\leftarrow\lbrack \fmslash{k}_V , \fmslash{V} \rbrack \gamma_\mu \gamma^5 \chi $
& [F32] & $\psi_\mu\leftarrow\lbrack \fmslash{k}_V , \gamma^\alpha \rbrack \gamma_\mu \gamma^5 \chi V_\alpha$ \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:dim5-fermions-gravmajo} Dimension-5 trilinear
couplings including one Majorana, one Gravitino fermion and one
additional particle. The table is essentially the same as the one
with the Dirac fermion and only written for the sake of completeness.}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.4}
\begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline
\multicolumn{4}{|l|}{[GBG (Chibar, POT, Grav)]: $\bar\chi \gamma^\mu S \psi_\mu$}\\\hline
[F12] & $\psi_\mu\leftarrow - \gamma_\mu \chi S$
& [F21] & $\psi_\mu\leftarrow - S \gamma_\mu\chi$ \\\hline
[F13] & $S\leftarrow \chi^T{\rm C}\gamma^\mu\psi_\mu$
& [F31] & $S\leftarrow \psi^T_\mu {\rm C} (-\gamma^\mu) \chi$ \\\hline
[F23] & $\chi\leftarrow S\gamma^\mu\psi_\mu$
& [F32] & $\chi\leftarrow \gamma^\mu\psi_\mu S$ \\\hline
\multicolumn{4}{|l|}{[GBG (Chibar, S, Grav)]: $\bar\chi \gamma^\mu \fmslash{k}_S S \psi_\mu$}\\\hline
[F12] & $\psi_\mu\leftarrow \fmslash{k}_S \gamma_\mu \chi S$
& [F21] & $\psi_\mu\leftarrow S \fmslash{k}_S \gamma_\mu\chi$ \\\hline
[F13] & $S\leftarrow \chi^T{\rm C}\gamma^\mu\fmslash{k}_S \psi_\mu$
& [F31] & $S\leftarrow \psi^T_\mu {\rm C} \fmslash{k}_S \gamma^\mu \chi$ \\\hline
[F23] & $\chi\leftarrow S\gamma^\mu\fmslash{k}_S\psi_\mu$
& [F32] & $\chi\leftarrow \gamma^\mu\fmslash{k}_S\psi_\mu S$ \\\hline
\multicolumn{4}{|l|}{[GBG (Chibar, P, Grav)]: $\bar\chi \gamma^\mu\gamma^5 P\fmslash{k}_P \psi_\mu$}\\\hline
[F12] & $\psi_\mu\leftarrow -\fmslash{k}_P \gamma_\mu \gamma^5 \chi P$
& [F21] & $\psi_\mu\leftarrow -P\fmslash{k}_P \gamma_\mu \gamma^5 \chi$ \\\hline
[F13] & $P\leftarrow \chi^T {\rm C}\gamma^\mu\gamma^5\fmslash{k}_P\psi_\mu$
& [F31] & $P\leftarrow -\psi^T_\mu {\rm C}\fmslash{k}_P\gamma^\mu\gamma_5\chi$ \\\hline
[F23] & $\chi\leftarrow P \gamma^\mu\gamma^5\fmslash{k}_P\psi_\mu$
& [F32] & $\chi\leftarrow \gamma^\mu\gamma^5\fmslash{k}_P\psi_\mu P$ \\\hline
\multicolumn{4}{|l|}{[GBG (Chibar, V, Grav)]: $\bar\chi\gamma^5\gamma^\mu\lbrack\fmslash{k}_V,\fmslash{V}\rbrack\psi_\mu$}\\\hline
[F12] & $\psi_\mu\leftarrow \lbrack \fmslash{k}_V , \gamma^\alpha \rbrack \gamma_\mu \gamma^5 \chi V_\alpha$
& [F21] & $\psi_\mu\leftarrow \lbrack \fmslash{k}_V , \fmslash{V} \rbrack \gamma_\mu \gamma^5 \chi$ \\\hline
[F13] & $V_{\mu}\leftarrow \chi^T {\rm C} \gamma^5 \gamma^\rho \lbrack \fmslash{k}_V , \gamma_\mu \rbrack \psi_\rho$
& [F31] & $V_{\mu}\leftarrow \psi^T_\rho {\rm C} \lbrack \fmslash{k}_V , \gamma_\mu \rbrack \gamma^\rho \gamma^5 \chi$ \\\hline
[F23] & $\chi\leftarrow\gamma^5\gamma^\mu\lbrack \fmslash{k}_V , \fmslash{V} \rbrack\psi_\mu$
& [F32] & $\chi\leftarrow\gamma^5\gamma^\mu\lbrack \fmslash{k}_V , \gamma^\alpha \rbrack\psi_\mu V_\alpha$ \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:dim5-fermions-majograv} Dimension-5 trilinear
couplings including one conjugated Majorana, one Gravitino fermion and
one additional particle. This table is not only the same as the one
with the conjugated Dirac fermion but also the same part of the
Lagrangian density as the one with the Majorana particle on the right
of the gravitino.}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.4}
\begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline
\multicolumn{2}{|l|}{[GBBG (Gravbar, S2, Psi)]: $\bar\psi_\mu S_1 S_2
\gamma^\mu \psi$}\\\hline
[F123] [F213] [F132] [F231] [F312] [F321] & $\psi\leftarrow - \gamma^\mu S_1 S_2 \psi_\mu$ \\ \hline
[F423] [F243] [F432] [F234] [F342] [F324] & $\psi_\mu \leftarrow \gamma_\mu S_1 S_2 \psi$ \\ \hline
[F134] [F143] [F314] & $S_1 \leftarrow \psi^T_\mu C S_2 \gamma^\mu \psi$ \\ \hline
[F124] [F142] [F214] & $S_2 \leftarrow \psi^T_\mu C S_1 \gamma^\mu \psi$ \\ \hline
[F413] [F431] [F341] & $S_1 \leftarrow - \psi^T C S_2 \gamma^\mu \psi_\mu$ \\ \hline
[F412] [F421] [F241] & $S_2 \leftarrow - \psi^T C S_1 \gamma^\mu \psi_\mu$ \\ \hline
\multicolumn{2}{|l|}{[GBBG (Gravbar, SV, Psi)]: $\bar\psi_\mu S \fmslash{V} \gamma^\mu \gamma^5 \psi$}\\\hline
[F123] [F213] [F132] [F231] [F312] [F321] & $\psi\leftarrow \gamma^5 \gamma^\mu S \fmslash{V} \psi_\mu$ \\ \hline
[F423] [F243] [F432] [F234] [F342] [F324] & $\psi_\mu \leftarrow \fmslash{V} S \gamma_\mu \gamma^5 \psi$ \\ \hline
[F134] [F143] [F314] & $S \leftarrow \psi^T_\mu C \fmslash{V} \gamma^\mu \gamma^5 \psi$ \\ \hline
[F124] [F142] [F214] & $V_\mu \leftarrow \psi^T_\rho C S \gamma_\mu \gamma^\rho \gamma^5 \psi$ \\ \hline
[F413] [F431] [F341] & $S \leftarrow \psi^T C \gamma^5 \gamma^\mu \fmslash{V} \psi_\mu$ \\ \hline
[F412] [F421] [F241] & $V_\mu \leftarrow \psi^T C S \gamma^5 \gamma^\rho \gamma_\mu \psi_\rho$ \\ \hline
\multicolumn{2}{|l|}{[GBBG (Gravbar, PV, Psi)]: $\bar\psi_\mu P \fmslash{V} \gamma^\mu \psi$}\\\hline
[F123] [F213] [F132] [F231] [F312] [F321] & $\psi\leftarrow \gamma^\mu P \fmslash{V} \psi_\mu$ \\ \hline
[F423] [F243] [F432] [F234] [F342] [F324] & $\psi_\mu \leftarrow \fmslash{V} P \gamma_\mu \psi$ \\ \hline
[F134] [F143] [F314] & $P \leftarrow \psi^T_\mu C \fmslash{V} \gamma^\mu \psi$ \\ \hline
[F124] [F142] [F214] & $V_\mu \leftarrow \psi^T_\rho C P \gamma_\mu \gamma^\rho \psi$ \\ \hline
[F413] [F431] [F341] & $P \leftarrow \psi^T C \gamma^\mu \fmslash{V} \psi_\mu$ \\ \hline
[F412] [F421] [F241] & $V_\mu \leftarrow \psi^T C P \gamma^\rho \gamma_\mu \psi_\rho$ \\ \hline
\multicolumn{2}{|l|}{[GBBG (Gravbar, V2, Psi)]: $\bar\psi_\mu f_{abc} \lbrack \fmslash{V}^a , \fmslash{V}^b \rbrack\gamma^\mu \gamma^5 \psi$}\\\hline
[F123] [F213] [F132] [F231] [F312] [F321] & $\psi\leftarrow f_{abc} \gamma^5 \gamma^\mu \lbrack \fmslash{V}^a , \fmslash{V}^b \rbrack \psi_\mu$ \\ \hline
[F423] [F243] [F432] [F234] [F342] [F324] & $\psi_\mu \leftarrow f_{abc} \lbrack \fmslash{V}^a , \fmslash{V}^b \rbrack \gamma_\mu \gamma^5 \psi$ \\ \hline
[F134] [F143] [F314] [F124] [F142] [F214] & $V_\mu^a \leftarrow\psi^T_\rho C f_{abc} \lbrack \gamma_\mu , \fmslash{V}^b \rbrack \gamma^\rho \gamma^5 \psi$ \\ \hline
[F413] [F431] [F341] [F412] [F421] [F241] & $V_\mu^a \leftarrow\psi^T C f_{abc} \gamma^5 \gamma^\rho\lbrack \gamma_\mu , \fmslash{V}^b \rbrack \psi_\rho$ \\ \hline
\end{tabular}
\end{center}
\caption{\label{tab:dim5-gravferm2boson} Dimension-5 trilinear
couplings including one Dirac, one Gravitino fermion and two additional bosons. In each lines we list the fusion possibilities with the same order of the fermions, but the order of the bosons is arbitrary (of course, one has to take care of this order in the mapping of the wave functions in [fusion]).}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.4}
\begin{tabular}{|>{\qquad}r<{:}l|r<{:}l|}\hline
\multicolumn{2}{|l|}{[GBBG (Psibar, S2, Grav)]: $\bar\psi S_1 S_2
\gamma^\mu \psi_\mu$}\\\hline
[F123] [F213] [F132] [F231] [F312] [F321] & $\psi_\mu\leftarrow - \gamma_\mu S_1 S_2 \psi$ \\ \hline
[F423] [F243] [F432] [F234] [F342] [F324] & $\psi \leftarrow \gamma^\mu S_1 S_2 \psi_\mu$ \\ \hline
[F134] [F143] [F314] & $S_1 \leftarrow \psi^T C S_2 \gamma^\mu \psi_\mu$ \\ \hline
[F124] [F142] [F214] & $S_2 \leftarrow \psi^T C S_1 \gamma^\mu \psi_\mu$ \\ \hline
[F413] [F431] [F341] & $S_1 \leftarrow - \psi^T_\mu C S_2 \gamma^\mu \psi$ \\ \hline
[F412] [F421] [F241] & $S_2 \leftarrow - \psi^T_\mu C S_1 \gamma^\mu \psi$ \\ \hline
\multicolumn{2}{|l|}{[GBBG (Psibar, SV, Grav)]: $\bar\psi S \gamma^\mu \gamma^5 \fmslash{V} \psi_\mu$}\\\hline
[F123] [F213] [F132] [F231] [F312] [F321] & $\psi_\mu\leftarrow \fmslash{V} S \gamma^5 \gamma^\mu \psi$ \\ \hline
[F423] [F243] [F432] [F234] [F342] [F324] & $\psi\leftarrow \gamma^\mu\gamma^5 S\fmslash{V}\psi_\mu$ \\ \hline
[F134] [F143] [F314] & $S \leftarrow \psi^T C \gamma^\mu \gamma^5 \fmslash{V}\psi$ \\ \hline
[F124] [F142] [F214] & $V_\mu \leftarrow \psi^T C \gamma^\rho \gamma^5 S \gamma_\mu \psi_\rho$ \\ \hline
[F413] [F431] [F341] & $S \leftarrow \psi^T_\mu C \fmslash{V} \gamma^5 \gamma^\mu \psi$ \\ \hline
[F412] [F421] [F241] & $V_\mu \leftarrow \psi^T_\rho C S \gamma_\mu \gamma^5 \gamma^\rho \psi$ \\ \hline
\multicolumn{2}{|l|}{[GBBG (Psibar, PV, Grav)]: $\bar\psi P \gamma^\mu \fmslash{V} \psi_\mu$}\\\hline
[F123] [F213] [F132] [F231] [F312] [F321] & $\psi_\mu\leftarrow \fmslash{V}\gamma_\mu P \psi$ \\ \hline
[F423] [F243] [F432] [F234] [F342] [F324] & $\psi\leftarrow \gamma^\mu\fmslash{V} P\psi_\mu$ \\ \hline
[F134] [F143] [F314] & $P \leftarrow \psi^T C \gamma^\mu\fmslash{V}\psi_\mu$ \\ \hline
[F124] [F142] [F214] & $V_\mu \leftarrow \psi^T C P \gamma^\rho \gamma_\mu \psi_\rho$ \\ \hline
[F413] [F431] [F341] & $P \leftarrow \psi^T_\mu C \fmslash{V}\gamma^\mu \psi$ \\ \hline
[F412] [F421] [F241] & $V_\mu \leftarrow \psi^T_\rho C P \gamma_\mu \gamma^\rho \psi$ \\ \hline
\multicolumn{2}{|l|}{[GBBG (Psibar, V2, Grav)]: $\bar\psi f_{abc} \gamma^5 \gamma^\mu \lbrack \fmslash{V}^a , \fmslash{V}^b \rbrack\psi_\mu$}\\\hline
[F123] [F213] [F132] [F231] [F312] [F321] & $\psi_\mu\leftarrow f_{abc} \lbrack \fmslash{V}^a , \fmslash{V}^b \rbrack \gamma_\mu \gamma^5 \psi$ \\ \hline
[F423] [F243] [F432] [F234] [F342] [F324] & $\psi\leftarrow f_{abc} \gamma^5\gamma^\mu\lbrack \fmslash{V}^a , \fmslash{V}^b \rbrack\psi_\mu$ \\ \hline
[F134] [F143] [F314] [F124] [F142] [F214] & $V_\mu^a \leftarrow\psi^T C f_{abc} \gamma^5\gamma^\rho\lbrack \gamma_\mu , \fmslash{V}^b \rbrack\psi_\rho$ \\ \hline
[F413] [F431] [F341] [F412] [F421] [F241] & $V_\mu^a \leftarrow\psi^T_\rho C f_{abc}\lbrack \gamma_\mu , \fmslash{V}^b \rbrack\gamma^\rho\gamma^5 \psi$ \\ \hline
\end{tabular}
\end{center}
\caption{\label{tab:dim5-gravferm2boson2} Dimension-5 trilinear
couplings including one conjugated Dirac, one Gravitino fermion and two additional bosons. The couplings of Majorana fermions to the gravitino and two bosons are essentially the same as for Dirac fermions and they are omitted here.}
\end{table}
*)
(* \thocwmodulesection{Perturbative Quantum Gravity and Kaluza-Klein Interactions}
The gravitational coupling constant and the relative strength of
the dilaton coupling are abbreviated as
\begin{subequations}
\begin{align}
\kappa &= \sqrt{16\pi G_N} \\
\omega &= \sqrt{\frac{2}{3(n+2)}} = \sqrt{\frac{2}{3(d-2)}}\,,
\end{align}
\end{subequations}
where~$n=d-4$ is the number of extra space dimensions. *)
(* In~(\ref{eq:graviton-feynman-rules3}-\ref{eq:dilaton-feynman-rules5}),
we use the notation of~\cite{Han/Lykken/Zhang:1999:Kaluza-Klein}:
\begin{subequations}
\begin{equation}
C_{\mu\nu,\rho\sigma} =
g_{\mu\rho} g_{\nu\sigma} + g_{\mu\sigma} g_{\nu\rho}
- g_{\mu\nu} g_{\rho\sigma}
\end{equation}
\begin{multline}
D_{\mu\nu,\rho\sigma}(k_1,k_2) =
g_{\mu\nu} k_{1,\sigma} k_{2,\rho} \\
\mbox{}
- ( g_{\mu\sigma} k_{1,\nu} k_{2,\rho}
+ g_{\mu\rho} k_{1,\sigma} k_{2,\nu}
- g_{\rho\sigma} k_{1,\mu} k_{2,\nu}
+ (\mu\leftrightarrow\nu))
\end{multline}
\begin{multline}
E_{\mu\nu,\rho\sigma}(k_1,k_2) =
g_{\mu\nu} (k_{1,\rho} k_{1,\sigma}
+ k_{2,\rho} k_{2,\sigma} + k_{1,\rho} k_{2,\sigma}) \\
\mbox{}
- ( g_{\nu\sigma} k_{1,\mu} k_{1,\rho}
+ g_{\nu\rho} k_{2,\mu} k_{2,\sigma}
+ (\mu\leftrightarrow\nu))
\end{multline}
\begin{multline}
F_{\mu\nu,\rho\sigma\lambda}(k_1,k_2,k_3) = \\
g_{\mu\rho} g_{\sigma\lambda} (k_2 - k_3)_{\nu}
+ g_{\mu\sigma} g_{\lambda\rho} (k_3 - k_1)_{\nu}
+ g_{\mu\lambda} g_{\rho\sigma} (k_1 - k_2)_{\nu}
+ (\mu\leftrightarrow\nu)
\end{multline}
\begin{multline}
G_{\mu\nu,\rho\sigma\lambda\delta} =
g_{\mu\nu} (g_{\rho\sigma}g_{\lambda\delta} - g_{\rho\delta}g_{\lambda\sigma})
\\ \mbox{}
+ ( g_{\mu\rho}g_{\nu\delta}g_{\lambda\sigma}
+ g_{\mu\lambda}g_{\nu\sigma}g_{\rho\delta}
- g_{\mu\rho}g_{\nu\sigma}g_{\lambda\delta}
- g_{\mu\lambda}g_{\nu\delta}g_{\rho\sigma}
+ (\mu\leftrightarrow\nu) )
\end{multline}
\end{subequations} *)
(* \begin{figure}
\begin{subequations}
\label{eq:graviton-feynman-rules3}
\begin{align}
\label{eq:graviton-scalar-scalar}
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22)
\Threeexternal{1}{2}{h_{\mu\nu}}
\fmf{plain}{v,e1}
\fmf{plain}{v,e2}
\fmf{dbl_dots}{v,e3}
\threeoutgoing
\end{fmfgraph*}}} \,&=
\begin{split}
\mbox{} & - \ii \frac{\kappa}{2} g_{\mu\nu} m^2
+ \ii \frac{\kappa}{2} C_{\mu\nu,\mu_1\mu_2}k^{\mu_1}_1k^{\mu_2}_2
\end{split} \\
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22)
\Threeexternal{1}{2}{h_{\mu\nu}}
\fmf{photon}{v,e1}
\fmf{photon}{v,e2}
\fmf{dbl_dots}{v,e3}
\threeoutgoing
\end{fmfgraph*}}} \,&=
\begin{split}
\mbox{} - \ii \frac{\kappa}{2} m^2 C_{\mu\nu,\mu_1\mu_2}
- \ii \frac{\kappa}{2}
(& k_1k_2 C_{\mu\nu,\mu_1\mu_2} \\
&\mbox{} + D_{\mu\nu,\mu_1\mu_2}(k_1,k_2) \\
&\mbox{} + \xi^{-1} E_{\mu\nu,\mu_1\mu_2}(k_1,k_2))
\end{split} \\
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22)
\Threeexternal{p}{p'}{h_{\mu\nu}}
\fmf{fermion}{e1,v,e2}
\fmf{dbl_dots}{v,e3}
\fmfdot{v}
\end{fmfgraph*}}} \,&=
\begin{split}
\mbox{} - \ii \frac{\kappa}{2} m g_{\mu\nu}
- \ii \frac{\kappa}{8}
(& \gamma_{\mu}(p+p')_{\nu} + \gamma_{\nu}(p+p')_{\mu} \\
& \mbox{} - 2 g_{\mu\nu} (\fmslash{p}+\fmslash{p}') )
\end{split}
\end{align}
\end{subequations}
\caption{\label{fig:graviton-feynman-rules3} Three-point graviton couplings.}
\end{figure}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.4}
\begin{tabular}{|>{\qquad}r<{:}l|}\hline
\multicolumn{2}{|l|}{[Graviton_Scalar_Scalar]:
$h_{\mu\nu} C^{\mu\nu}_{0}(k_1,k_2)\phi_1\phi_2$}\\\hline
[F12|F21]
& $\phi_2 \leftarrow \ii\cdot
h_{\mu\nu} C^{\mu\nu}_{0} (k_1, -k-k_1)\phi_1 $ \\\hline
[F13|F31]
& $\phi_1 \leftarrow \ii\cdot
h_{\mu\nu} C^{\mu\nu}_{0} (-k-k_2, k_2)\phi_2 $ \\\hline
[F23|F32]
& $h^{\mu\nu} \leftarrow \ii\cdot
C^{\mu\nu}_0 (k_1,k_2)\phi_1\phi_2 $ \\\hline
\multicolumn{2}{|l|}{[Graviton_Vector_Vector]:
$h_{\mu\nu} C^{\mu\nu,\mu_1\mu_2}_1(k_1,k_2,\xi)
V_{\mu_1}V_{\mu_2} $}\\\hline
[F12|F21] & $ V^\mu_2 \leftarrow \ii\cdot h_{\kappa\lambda}
C^{\kappa\lambda,\mu\nu}_1(-k-k_1,k_1\xi) V_{1,\nu}$ \\\hline
[F13|F31] & $ V^\mu_1 \leftarrow \ii\cdot h_{\kappa\lambda}
C^{\kappa\lambda,\mu\nu}_1(-k-k_2,k_2,\xi) V_{2,\nu}$ \\\hline
[F23|F32]
& $h^{\mu\nu} \leftarrow \ii\cdot
C^{\mu\nu,\mu_1\mu_2}_1(k_1,k_2,\xi)
V_{1,\mu_1}V_{2,\mu_2} $ \\\hline
\multicolumn{2}{|l|}{[Graviton_Spinor_Spinor]:
$h_{\mu\nu} \bar\psi_1
C^{\mu\nu}_{\frac{1}{2}}(k_1,k_2)\psi_2 $}\\\hline
[F12] & $ \bar\psi_2 \leftarrow \ii\cdot
h_{\mu\nu} \bar\psi_1 C^{\mu\nu}_{\frac{1}{2}}(k_1,-k-k_1) $ \\\hline
[F21] & $ \bar\psi_2 \leftarrow \ii\cdot\ldots $ \\\hline
[F13] & $ \psi_1 \leftarrow \ii\cdot
h_{\mu\nu}C^{\mu\nu}_{\frac{1}{2}}(-k-k_2,k_2)\psi_2$ \\\hline
[F31] & $ \psi_1 \leftarrow \ii\cdot\ldots $ \\\hline
[F23] & $ h^{\mu\nu} \leftarrow \ii\cdot
\bar\psi_1 C^{\mu\nu}_{\frac{1}{2}}(k_1,k_2)\psi_2 $ \\\hline
[F32] & $ h^{\mu\nu} \leftarrow \ii\cdot\ldots $ \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:graviton-three-point} \ldots}
\end{table}
Derivation of~(\ref{eq:graviton-scalar-scalar})
\begin{subequations}
\begin{align}
L &= \frac{1}{2} (\partial_\mu \phi) (\partial^\mu \phi) - \frac{m^2}{2} \phi^2 \\
(\partial_\mu\phi) \frac{\partial L}{\partial(\partial^\nu\phi)}
&= (\partial_\mu\phi)(\partial_\nu\phi) \\
T_{\mu\nu} &= -g_{\mu\nu} L +
(\partial_\mu\phi) \frac{\partial L}{\partial(\partial^\nu\phi)}
+
\end{align}
\end{subequations}
\begin{subequations}
\begin{align}
C^{\mu\nu}_{0}(k_1,k_2)
&= C^{\mu\nu,\mu_1\mu_2} k_{1,\mu_1} k_{2,\mu_2} \\
C^{\mu\nu,\mu_1\mu_2}_1(k_1,k_2,\xi)
&= k_1k_2 C^{\mu\nu,\mu_1\mu_2}
+ D^{\mu\nu,\mu_1\mu_2}(k_1,k_2)
+ \xi^{-1} E^{\mu\nu,\mu_1\mu_2}(k_1,k_2) \\
C^{\mu\nu}_{\frac{1}{2},\alpha\beta}(p,p')
&= \gamma^{\mu}_{\alpha\beta}(p+p')^{\nu}
+ \gamma^{\nu}_{\alpha\beta}(p+p')^{\mu}
- 2 g^{\mu\nu} (\fmslash{p}+\fmslash{p}')_{\alpha\beta}
\end{align}
\end{subequations} *)
(* \begin{figure}
\begin{subequations}
\label{eq:dilaton-feynman-rules3}
\begin{align}
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22)
\Threeexternal{1}{2}{\phi(k)}
\fmf{plain}{v,e1}
\fmf{plain}{v,e2}
\fmf{dots}{v,e3}
\threeoutgoing
\end{fmfgraph*}}} \,&=
- \ii \omega \kappa 2m^2 - \ii \omega \kappa k_1k_2 \\
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22)
\Threeexternal{1}{2}{\phi(k)}
\fmf{photon}{v,e1}
\fmf{photon}{v,e2}
\fmf{dots}{v,e3}
\threeoutgoing
\end{fmfgraph*}}} \,&=
- \ii \omega \kappa g_{\mu_1\mu_2}m^2
- \ii \omega \kappa
\xi^{-1} (k_{1,\mu_1}k_{\mu_2} + k_{2,\mu_2}k_{\mu_1}) \\
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22)
\Threeexternal{p}{p'}{\phi(k)}
\fmf{fermion}{e1,v,e2}
\fmf{dots}{v,e3}
\fmfdot{v}
\end{fmfgraph*}}} \,&=
- \ii \omega \kappa 2m
+ \ii \omega \kappa \frac{3}{4}(\fmslash{p}+\fmslash{p}')
\end{align}
\end{subequations}
\caption{\label{fig:dilaton-feynman-rules3} Three-point dilaton couplings.}
\end{figure}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.4}
\begin{tabular}{|>{\qquad}r<{:}l|}\hline
\multicolumn{2}{|l|}{[Dilaton_Scalar_Scalar]:
$\phi \ldots k_1k_2\phi_1\phi_2 $}\\\hline
[F12|F21] & $ \phi_2 \leftarrow \ii\cdot k_1(-k-k_1)\phi\phi_1 $ \\\hline
[F13|F31] & $ \phi_1 \leftarrow \ii\cdot (-k-k_2)k_2\phi\phi_2 $ \\\hline
[F23|F32] & $ \phi \leftarrow \ii\cdot k_1k_2\phi_1\phi_2 $ \\\hline
\multicolumn{2}{|l|}{[Dilaton_Vector_Vector]:
$\phi \ldots $}\\\hline
[F12] & $ V_{2,\mu} \leftarrow \ii\cdot\ldots $ \\\hline
[F21] & $ V_{2,\mu} \leftarrow \ii\cdot\ldots $ \\\hline
[F13] & $ V_{1,\mu} \leftarrow \ii\cdot\ldots $ \\\hline
[F31] & $ V_{1,\mu} \leftarrow \ii\cdot\ldots $ \\\hline
[F23] & $ \phi \leftarrow \ii\cdot\ldots $ \\\hline
[F32] & $ \phi \leftarrow \ii\cdot\ldots $ \\\hline
\multicolumn{2}{|l|}{[Dilaton_Spinor_Spinor]:
$\phi \ldots $}\\\hline
[F12] & $ \bar\psi_2 \leftarrow \ii\cdot\ldots $ \\\hline
[F21] & $ \bar\psi_2 \leftarrow \ii\cdot\ldots $ \\\hline
[F13] & $ \psi_1 \leftarrow \ii\cdot\ldots $ \\\hline
[F31] & $ \psi_1 \leftarrow \ii\cdot\ldots $ \\\hline
[F23] & $ \phi \leftarrow \ii\cdot\ldots $ \\\hline
[F32] & $ \phi \leftarrow \ii\cdot\ldots $ \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:dilaton-three-point} \ldots}
\end{table} *)
(* \begin{figure}
\begin{subequations}
\label{eq:graviton-feynman-rules4}
\begin{align}
\label{eq:graviton-scalar-scalar-scalar}
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22)
\Fourexternal{1}{2}{3}{h_{\mu\nu}}
\fmf{plain}{v,e1}
\fmf{plain}{v,e2}
\fmf{plain}{v,e3}
\fmf{dbl_dots}{v,e4}
\fouroutgoing
\end{fmfgraph*}}} \,&=
\begin{split}
\mbox{} & ???
\end{split} \\
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22)
\Fourexternal{1}{2}{3}{h_{\mu\nu}}
\fmf{plain}{v,e1}
\fmf{plain}{v,e2}
\fmf{photon}{v,e3}
\fmf{dbl_dots}{v,e4}
\fouroutgoing
\end{fmfgraph*}}} \,&=
\begin{split}
\mbox{} &
- \ii g\frac{\kappa}{2} C_{\mu\nu,\mu_3\rho}(k_1-k_2)^{\rho} T^{a_3}_{n_2n_1}
\end{split} \\
\label{eq:graviton-scalar-vector-vector}
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22)
\Fourexternal{1}{2}{3}{h_{\mu\nu}}
\fmf{plain}{v,e1}
\fmf{photon}{v,e2}
\fmf{photon}{v,e3}
\fmf{dbl_dots}{v,e4}
\fouroutgoing
\end{fmfgraph*}}} \,&=
\begin{split}
\mbox{} & ???
\end{split} \\
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22)
\Fourexternal{1}{2}{3}{h_{\mu\nu}}
\fmf{photon}{v,e1}
\fmf{photon}{v,e2}
\fmf{photon}{v,e3}
\fmf{dbl_dots}{v,e4}
\fouroutgoing
\end{fmfgraph*}}} \,&=
\begin{split}
\mbox{} - g \frac{\kappa}{2} f^{a_1a_2a_3}
(& C_{\mu\nu,\mu_1\mu_2} (k_1-k_2)_{\mu_3} \\
& \mbox{} + C_{\mu\nu,\mu_2\mu_3} (k_2-k_3)_{\mu_1} \\
& \mbox{} + C_{\mu\nu,\mu_3\mu_1} (k_3-k_1)_{\mu_2} \\
& \mbox{} + F_{\mu\nu,\mu_1\mu_2\mu_3}(k_1,k_2,k_3) )
\end{split} \\
\label{eq:graviton-yukawa}
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22)
\Fourexternal{1}{2}{3}{h_{\mu\nu}}
\fmf{fermion}{e1,v,e2}
\fmf{plain}{v,e3}
\fmf{dbl_dots}{v,e4}
\fmfdot{v}
\fmffreeze
\fmf{warrow_right}{v,e3}
\fmf{warrow_right}{v,e4}
\end{fmfgraph*}}} \,&=
\begin{split}
\mbox{} & ???
\end{split} \\
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22)
\Fourexternal{1}{2}{3}{h_{\mu\nu}}
\fmf{fermion}{e1,v,e2}
\fmf{photon}{v,e3}
\fmf{dbl_dots}{v,e4}
\fmfdot{v}
\fmffreeze
\fmf{warrow_right}{v,e3}
\fmf{warrow_right}{v,e4}
\end{fmfgraph*}}} \,&=
\begin{split}
\mbox{} & \ii g\frac{\kappa}{4}
(C_{\mu\nu,\mu_3\rho} - g_{\mu\nu}g_{\mu_3\rho})
\gamma^{\rho} T^{a_3}_{n_2n_1}
\end{split}
\end{align}
\end{subequations}
\caption{\label{fig:graviton-feynman-rules4} Four-point graviton couplings.
(\ref{eq:graviton-scalar-scalar-scalar}),
(\ref{eq:graviton-scalar-vector-vector}),
and~(\ref{eq:graviton-yukawa)} are missing
in~\cite{Han/Lykken/Zhang:1999:Kaluza-Klein}, but should be generated
by standard model Higgs selfcouplings, Higgs-gaugeboson couplings, and
Yukawa couplings.}
\end{figure} *)
(* \begin{figure}
\begin{subequations}
\label{eq:dilaton-feynman-rules4}
\begin{align}
\label{eq:dilaton-scalar-scalar-scalar}
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22)
\Fourexternal{1}{2}{3}{\phi(k)}
\fmf{plain}{v,e1}
\fmf{plain}{v,e2}
\fmf{plain}{v,e3}
\fmf{dots}{v,e4}
\fouroutgoing
\end{fmfgraph*}}} \,&= ??? \\
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22)
\Fourexternal{1}{2}{3}{\phi(k)}
\fmf{plain}{v,e1}
\fmf{plain}{v,e2}
\fmf{photon}{v,e3}
\fmf{dots}{v,e4}
\fouroutgoing
\end{fmfgraph*}}} \,&=
- \ii \omega \kappa (k_1 + k_2)_{\mu_3} T^{a_3}_{n_1,n_2} \\
\label{eq:dilaton-scalar-vector-vector}
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22)
\Fourexternal{1}{2}{3}{\phi(k)}
\fmf{plain}{v,e1}
\fmf{photon}{v,e2}
\fmf{photon}{v,e3}
\fmf{dots}{v,e4}
\fouroutgoing
\end{fmfgraph*}}} \,&= ??? \\
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22)
\Fourexternal{1}{2}{3}{\phi(k)}
\fmf{photon}{v,e1}
\fmf{photon}{v,e2}
\fmf{photon}{v,e3}
\fmf{dots}{v,e4}
\fouroutgoing
\end{fmfgraph*}}} \,&= 0 \\
\label{eq:dilaton-yukawa}
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22)
\Fourexternal{1}{2}{3}{h_{\mu\nu}}
\fmf{fermion}{e1,v,e2}
\fmf{plain}{v,e3}
\fmf{dots}{v,e4}
\fmfdot{v}
\fmffreeze
\fmf{warrow_right}{v,e3}
\fmf{warrow_right}{v,e4}
\end{fmfgraph*}}} \,&= ??? \\
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22)
\Fourexternal{1}{2}{3}{\phi(k)}
\fmf{fermion}{e1,v,e2}
\fmf{photon}{v,e3}
\fmf{dots}{v,e4}
\fmfdot{v}
\fmffreeze
\fmf{warrow_right}{v,e3}
\fmf{warrow_right}{v,e4}
\end{fmfgraph*}}} \,&=
- \ii \frac{3}{2} \omega g \kappa \gamma_{\mu_3} T^{a_3}_{n_1n_2}
\end{align}
\end{subequations}
\caption{\label{fig:dilaton-feynman-rules4} Four-point dilaton couplings.
(\ref{eq:dilaton-scalar-scalar-scalar}),
(\ref{eq:dilaton-scalar-vector-vector})
and~(\ref{eq:dilaton-yukawa}) are missing
in~\cite{Han/Lykken/Zhang:1999:Kaluza-Klein}, but could be generated
by standard model Higgs selfcouplings, Higgs-gaugeboson couplings,
and Yukawa couplings.}
\end{figure} *)
(* \begin{figure}
\begin{subequations}
\label{eq:graviton-feynman-rules5}
\begin{align}
\label{eq:graviton-scalar-scalar-scalar-scalar}
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22)
\Fiveexternal{1}{2}{3}{4}{h_{\mu\nu}}
\fmf{plain}{v,e1}
\fmf{plain}{v,e2}
\fmf{plain}{v,e3}
\fmf{plain}{v,e4}
\fmf{dots}{v,e5}
\fiveoutgoing
\end{fmfgraph*}}} \,&=
\begin{split}
\mbox{} & ???
\end{split} \\
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22)
\Fiveexternal{1}{2}{3}{4}{h_{\mu\nu}}
\fmf{plain}{v,e1}
\fmf{plain}{v,e2}
\fmf{photon}{v,e3}
\fmf{photon}{v,e4}
\fmf{dots}{v,e5}
\fiveoutgoing
\end{fmfgraph*}}} \,&=
\begin{split}
\mbox{} & - \ii g^2 \frac{\kappa}{2} C_{\mu\nu,\mu_3\mu_4}
(T^{a_3}T^{a_4} + T^{a_4}T^{a_3})_{n_2n_1}
\end{split} \\
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22)
\Fiveexternal{1}{2}{3}{4}{h_{\mu\nu}}
\fmf{photon}{v,e1}
\fmf{photon}{v,e2}
\fmf{photon}{v,e3}
\fmf{photon}{v,e4}
\fmf{dots}{v,e5}
\fiveoutgoing
\end{fmfgraph*}}} \,&=
\begin{split}
\mbox{} - \ii g^2 \frac{\kappa}{2}
(& f^{ba_1a_3} f^{ba_2a_4} G_{\mu\nu,\mu_1\mu_2\mu_3\mu_4} \\
& \mbox + f^{ba_1a_2} f^{ba_3a_4} G_{\mu\nu,\mu_1\mu_3\mu_2\mu_4} \\
& \mbox + f^{ba_1a_4} f^{ba_2a_3} G_{\mu\nu,\mu_1\mu_2\mu_4\mu_3} )
\end{split}
\end{align}
\end{subequations}
\caption{\label{fig:graviton-feynman-rules5} Five-point graviton couplings.
(\ref{eq:graviton-scalar-scalar-scalar-scalar}) is missing
in~\cite{Han/Lykken/Zhang:1999:Kaluza-Klein}, but should be generated
by standard model Higgs selfcouplings.}
\end{figure} *)
(* \begin{figure}
\begin{subequations}
\label{eq:dilaton-feynman-rules5}
\begin{align}
\label{eq:dilaton-scalar-scalar-scalar-scalar}
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22)
\Fiveexternal{1}{2}{3}{4}{\phi(k)}
\fmf{plain}{v,e1}
\fmf{plain}{v,e2}
\fmf{plain}{v,e3}
\fmf{plain}{v,e4}
\fmf{dots}{v,e5}
\fiveoutgoing
\end{fmfgraph*}}} \,&= ??? \\
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22)
\Fiveexternal{1}{2}{3}{4}{\phi(k)}
\fmf{plain}{v,e1}
\fmf{plain}{v,e2}
\fmf{photon}{v,e3}
\fmf{photon}{v,e4}
\fmf{dots}{v,e5}
\fiveoutgoing
\end{fmfgraph*}}} \,&=
\ii \omega g^2 \kappa g_{\mu_3\mu_4}
(T^{a_3}T^{a_4} + T^{a_4}T^{a_3})_{n_2n_1} \\
\parbox{28mm}{\fmfframe(2,2)(2,1){\begin{fmfgraph*}(24,22)
\Fiveexternal{1}{2}{3}{4}{\phi(k)}
\fmf{photon}{v,e1}
\fmf{photon}{v,e2}
\fmf{photon}{v,e3}
\fmf{photon}{v,e4}
\fmf{dots}{v,e5}
\fiveoutgoing
\end{fmfgraph*}}} \,&= 0
\end{align}
\end{subequations}
\caption{\label{fig:dilaton-feynman-rules5} Five-point dilaton couplings.
(\ref{eq:dilaton-scalar-scalar-scalar-scalar}) is missing
in~\cite{Han/Lykken/Zhang:1999:Kaluza-Klein}, but could be generated
by standard model Higgs selfcouplings.}
\end{figure} *)
(* \thocwmodulesection{Dependent Parameters}
This is a simple abstract syntax for parameter dependencies.
Later, there will be a parser for a convenient concrete syntax
as a part of a concrete syntax for models. There is no intention
to do \emph{any} symbolic manipulation with this. The expressions
will be translated directly by [Targets] to the target language. *)
type 'a expr =
| I | Const of int
| Atom of 'a
| Sum of 'a expr list
| Diff of 'a expr * 'a expr
| Neg of 'a expr
| Prod of 'a expr list
| Quot of 'a expr * 'a expr
| Rec of 'a expr
| Pow of 'a expr * int
| Sqrt of 'a expr
| Sin of 'a expr
| Cos of 'a expr
| Tan of 'a expr
| Cot of 'a expr
| Atan2 of 'a expr * 'a expr
| Conj of 'a expr
type 'a variable = Real of 'a | Complex of 'a
type 'a variable_array = Real_Array of 'a | Complex_Array of 'a
type 'a parameters =
{ input : ('a * float) list;
derived : ('a variable * 'a expr) list;
derived_arrays : ('a variable_array * 'a expr list) list }
(* \thocwmodulesection{More Exotic Couplings}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.3}
\begin{tabular}{|>{\qquad}r<{:}l|}\hline
\multicolumn{2}{|l|}{[Dim5_Scalar_Vector_Vector_T]:
$\mathcal{L}_I=g\phi
(\ii\partial_\mu V_1^\nu)(\ii\partial_\nu V_2^\mu)$}\\\hline
[F23] & $\phi(k_2+k_3)\leftarrow\ii\cdot g
k_3^\mu V_{1,\mu}(k_2) k_2^\nu V_{2,\nu}(k_3)$ \\\hline
[F32] & $\phi(k_2+k_3)\leftarrow\ii\cdot g
k_2^\mu V_{2,\mu}(k_3) k_3^\nu V_{1,\nu}(k_2)$ \\\hline
[F12] & $V_2^\mu(k_1+k_2)\leftarrow\ii\cdot g
k_2^\mu \phi(k_1) (-k_1^\nu-k_2^\nu) V_{1,\nu}(k_2)$ \\\hline
[F21] & $V_2^\mu(k_1+k_2)\leftarrow\ii\cdot g
k_2^\mu (-k_1^\nu-k_2^\nu)V_{1,\nu}(k_2) \phi(k_1)$ \\\hline
[F13] & $V_1^\mu(k_1+k_3)\leftarrow\ii\cdot g
k_3^\mu \phi(k_1) (-k_1^\nu-k_3^\nu)V_{2,\nu}(k_3)$ \\\hline
[F31] & $V_1^\mu(k_1+k_3)\leftarrow\ii\cdot g
k_3^\mu (-k_1^\nu-k_3^\nu)V_{2,\nu}(k_3) \phi(k_1)$ \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:dim5-scalar-vector-vector}
\ldots}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.3}
\begin{tabular}{|>{\qquad}r<{:}l|}\hline
\multicolumn{2}{|l|}{[Dim6_Vector_Vector_Vector_T]:
$\mathcal{L}_I=gV_1^\mu
((\ii\partial_\nu V_2^\rho)%
\ii\overleftrightarrow{\partial_\mu}
(\ii\partial_\rho V_3^\nu))$}\\\hline
[F23] & $V_1^\mu(k_2+k_3)\leftarrow\ii\cdot g
(k_2^\mu - k_3^\mu) k_3^\nu V_{2,\nu} (k_2)
k_2^\rho V_{3,\rho}(k_3)$ \\\hline
[F32] & $V_1^\mu(k_2+k_3)\leftarrow\ii\cdot g
(k_2^\mu - k_3^\mu) k_2^\nu V_{3,\nu} (k_3)
k_3^\rho V_{2,\rho}(k_2)$ \\\hline
[F12] & $V_3^\mu(k_1+k_2)\leftarrow\ii\cdot g
k_2^\mu (k_1^\nu+2k_2^\nu) V_{1,\nu} (k_1)
(-k_1^\rho-k_2^\rho) V_{2,\rho}(k_2)$ \\\hline
[F21] & $V_3^\mu(k_1+k_2)\leftarrow\ii\cdot g
k_2^\mu (-k_1^\rho-k_2^\rho) V_{2,\rho}(k_2)
(k_1^\nu+2k_2^\nu) V_{1,\nu} (k_1)$ \\\hline
[F13] & $V_2^\mu(k_1+k_3)\leftarrow\ii\cdot g
k_3^\mu (k_1^\nu+2k_3^\nu) V_{1,\nu} (k_1)
(-k_1^\rho-k_3^\rho) V_{3,\rho}(k_3)$ \\\hline
[F31] & $V_2^\mu(k_1+k_3)\leftarrow\ii\cdot g
k_3^\mu (-k_1^\rho-k_3^\rho) V_{3,\rho}(k_3)
(k_1^\nu+2k_3^\nu) V_{1,\nu} (k_1)$ \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:dim6-vector-vector-vector}
\ldots}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.3}
\begin{tabular}{|>{\qquad}r<{:}l|}\hline
\multicolumn{2}{|l|}{[Tensor_2_Vector_Vector]:
$\mathcal{L}_I=gT^{\mu\nu}
(V_{1,\mu}V_{2,\nu} + V_{1,\nu}V_{2,\mu})$}\\\hline
[F23] & $T^{\mu\nu}(k_2+k_3)\leftarrow\ii\cdot g
(V_{1,\mu}(k_2) V_{2,\nu}(k_3) + V_{1,\nu}(k_2) V_{2,\mu}(k_3))$ \\\hline
[F32] & $T^{\mu\nu}(k_2+k_3)\leftarrow\ii\cdot g
(V_{2,\nu}(k_3) V_{1,\mu}(k_2) + V_{2,\mu}(k_3) V_{1,\nu}(k_2))$ \\\hline
[F12] & $V_2^\mu(k_1+k_2)\leftarrow\ii\cdot g
(T^{\mu\nu}(k_1) + T^{\nu\mu}(k_1)) V_{1,\nu}(k_2)$ \\\hline
[F21] & $V_2^\mu(k_1+k_2)\leftarrow\ii\cdot g
V_{1,\nu}(k_2)(T^{\mu\nu}(k_1) + T^{\nu\mu}(k_1))$ \\\hline
[F13] & $V_1^\mu(k_1+k_3)\leftarrow\ii\cdot g
(T^{\mu\nu}(k_1) + T^{\nu\mu}(k_1)) V_{2,\nu}(k_3)$ \\\hline
[F31] & $V_1^\mu(k_1+k_3)\leftarrow\ii\cdot g
V_{2,\nu}(k_3) (T^{\mu\nu}(k_1) + T^{\nu\mu}(k_1))$ \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:tensor2-vector-vector}
\ldots}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.3}
\begin{tabular}{|>{\qquad}r<{:}l|}\hline
\multicolumn{2}{|l|}{[Dim5_Tensor_2_Vector_Vector_1]:
$\mathcal{L}_I=gT^{\alpha\beta}
(V_1^\mu
\ii\overleftrightarrow\partial_\alpha
\ii\overleftrightarrow\partial_\beta V_{2,\mu})$}\\\hline
[F23] & $T^{\alpha\beta}(k_2+k_3)\leftarrow\ii\cdot g
(k_2^\alpha-k_3^\alpha)(k_2^\beta-k_3^\beta)
V_1^\mu(k_2)V_{2,\mu}(k_3)$ \\\hline
[F32] & $T^{\alpha\beta}(k_2+k_3)\leftarrow\ii\cdot g
(k_2^\alpha-k_3^\alpha)(k_2^\beta-k_3^\beta)
V_{2,\mu}(k_3)V_1^\mu(k_2)$ \\\hline
[F12] & $V_2^\mu(k_1+k_2)\leftarrow\ii\cdot g
(k_1^\alpha+2k_2^\alpha) (k_1^\beta+2k_2^\beta)
T_{\alpha\beta}(k_1) V_1^\mu(k_2)$ \\\hline
[F21] & $V_2^\mu(k_1+k_2)\leftarrow\ii\cdot g
(k_1^\alpha+2k_2^\alpha) (k_1^\beta+2k_2^\beta)
V_1^\mu(k_2) T_{\alpha\beta}(k_1)$ \\\hline
[F13] & $V_1^\mu(k_1+k_3)\leftarrow\ii\cdot g
(k_1^\alpha+2k_3^\alpha) (k_1^\beta+2k_3^\beta)
T_{\alpha\beta}(k_1) V_2^\mu(k_3)$ \\\hline
[F31] & $V_1^\mu(k_1+k_3)\leftarrow\ii\cdot g
(k_1^\alpha+2k_3^\alpha) (k_1^\beta+2k_3^\beta)
V_2^\mu(k_3) T_{\alpha\beta}(k_1)$ \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:dim5-tensor2-vector-vector-1}
\ldots}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.3}
\begin{tabular}{|>{\qquad}r<{:}l|}\hline
\multicolumn{2}{|l|}{[Dim5_Tensor_2_Vector_Vector_2]:
$\mathcal{L}_I=gT^{\alpha\beta}
( V_1^\mu \ii\overleftrightarrow\partial_\beta (\ii\partial_\mu V_{2,\alpha})
+ V_1^\mu \ii\overleftrightarrow\partial_\alpha (\ii\partial_\mu V_{2,\beta}))
$}\\\hline
[F23] & $T^{\alpha\beta}(k_2+k_3)\leftarrow\ii\cdot g
(k_3^\beta-k_2^\beta) k_3^\mu V_{1,\mu}(k_2)V_2^\alpha(k_3)
+ (\alpha\leftrightarrow\beta)$ \\\hline
[F32] & $T^{\alpha\beta}(k_2+k_3)\leftarrow\ii\cdot g
(k_3^\beta-k_2^\beta) V_2^\alpha(k_3) k_3^\mu V_{1,\mu}(k_2)
+ (\alpha\leftrightarrow\beta)$ \\\hline
[F12] & $V_2^\alpha(k_1+k_2)\leftarrow\ii\cdot g
(k_1^\beta+2k_2^\beta)
(T^{\alpha\beta}(k_1)+T^{\beta\alpha}(k_1))
(k_1^\mu+k_2^\mu) V_{1,\mu}(k_2)$ \\\hline
[F21] & $V_2^\alpha(k_1+k_2)\leftarrow\ii\cdot g
(k_1^\mu+k_2^\mu) V_{1,\mu}(k_2)
(k_1^\beta+2k_2^\beta)
(T^{\alpha\beta}(k_1)+T^{\beta\alpha}(k_1))$ \\\hline
[F13] & $V_1^\alpha(k_1+k_3)\leftarrow\ii\cdot g
(k_1^\beta+2k_3^\beta)
(T^{\alpha\beta}(k_1)+T^{\beta\alpha}(k_1))
(k_1^\mu+k_3^\mu) V_{2,\mu}(k_3)$ \\\hline
[F31] & $V_1^\alpha(k_1+k_3)\leftarrow\ii\cdot g
(k_1^\mu+k_3^\mu) V_{2,\mu}(k_3)
(k_1^\beta+2k_3^\beta)
(T^{\alpha\beta}(k_1)+T^{\beta\alpha}(k_1))$ \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:dim5-tensor2-vector-vector-1'}
\ldots}
\end{table}
\begin{table}
\begin{center}
\renewcommand{\arraystretch}{1.3}
\begin{tabular}{|>{\qquad}r<{:}l|}\hline
\multicolumn{2}{|l|}{[Dim7_Tensor_2_Vector_Vector_T]:
$\mathcal{L}_I=gT^{\alpha\beta}
((\ii\partial^\mu V_1^\nu)
\ii\overleftrightarrow\partial_\alpha
\ii\overleftrightarrow\partial_\beta
(\ii\partial_\nu V_{2,\mu}))$}\\\hline
[F23] & $T^{\alpha\beta}(k_2+k_3)\leftarrow\ii\cdot g
(k_2^\alpha-k_3^\alpha)(k_2^\beta-k_3^\beta)
k_3^\mu V_{1,\mu}(k_2) k_2^\nu V_{2,\nu}(k_3)$ \\\hline
[F32] & $T^{\alpha\beta}(k_2+k_3)\leftarrow\ii\cdot g
(k_2^\alpha-k_3^\alpha)(k_2^\beta-k_3^\beta)
k_2^\nu V_{2,\nu}(k_3) k_3^\mu V_{1,\mu}(k_2)$ \\\hline
[F12] & $V_2^\mu(k_1+k_2)\leftarrow\ii\cdot g
k_2^\mu
(k_1^\alpha+2k_2^\alpha) (k_1^\beta+2k_2^\beta)
T_{\alpha\beta}(k_1) (-k_1^\nu-k_2^\nu)V_{1,\nu}(k_2)$ \\\hline
[F21] & $V_2^\mu(k_1+k_2)\leftarrow\ii\cdot g
k_2^\mu (-k_1^\nu-k_2^\nu)V_{1,\nu}(k_2)
(k_1^\alpha+2k_2^\alpha) (k_1^\beta+2k_2^\beta)
T_{\alpha\beta}(k_1)$ \\\hline
[F13] & $V_1^\mu(k_1+k_3)\leftarrow\ii\cdot g
k_3^\mu
(k_1^\alpha+2k_3^\alpha) (k_1^\beta+2k_3^\beta)
T_{\alpha\beta}(k_1) (-k_1^\nu-k_3^\nu) V_{2,\nu}(k_3)$ \\\hline
[F31] & $V_1^\mu(k_1+k_3)\leftarrow\ii\cdot g
k_3^\mu (-k_1^\nu-k_3^\nu) V_{2,\nu}(k_3)
(k_1^\alpha+2k_3^\alpha) (k_1^\beta+2k_3^\beta)
T_{\alpha\beta}(k_1)$ \\\hline
\end{tabular}
\end{center}
\caption{\label{tab:dim7-tensor2-vector-vector-T}
\ldots}
\end{table} *)
(*i
* Local Variables:
* mode:caml
* indent-tabs-mode:nil
* page-delimiter:"^(\\* .*\n"
* End:
i*)
Index: trunk/src/omega/src/omegalib.nw
===================================================================
--- trunk/src/omega/src/omegalib.nw (revision 3998)
+++ trunk/src/omega/src/omegalib.nw (revision 3999)
@@ -1,10050 +1,10072 @@
% $Id$
%
% Copyright (C) 1999-2012 by
% Wolfgang Kilian <kilian@physik.uni-siegen.de>
% Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
% Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
% Christian Speckner <christian.speckner@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.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@
\section{Trivia}
<<[[omega_spinors.f90]]>>=
<<Copyleft>>
module omega_spinors
use kinds
use constants
implicit none
private
public :: operator (*), operator (+), operator (-)
public :: abs
<<[[intrinsic :: abs]]>>
type, public :: conjspinor
! private (omegalib needs access, but DON'T TOUCH IT!)
complex(kind=default), dimension(4) :: a
end type conjspinor
type, public :: spinor
! private (omegalib needs access, but DON'T TOUCH IT!)
complex(kind=default), dimension(4) :: a
end type spinor
<<Declaration of operations for spinors>>
integer, parameter, public :: omega_spinors_2010_01_A = 0
contains
<<Implementation of operations for spinors>>
end module omega_spinors
@
<<[[intrinsic :: abs]] (if working)>>=
intrinsic :: abs
@
<<[[intrinsic :: conjg]] (if working)>>=
intrinsic :: conjg
@ well, the Intel Fortran Compiler chokes on these with an internal error:
<<[[intrinsic :: abs]]>>=
@
<<[[intrinsic :: conjg]]>>=
@
\subsection{Inner Product}
<<Declaration of operations for spinors>>=
interface operator (*)
module procedure conjspinor_spinor
end interface
private :: conjspinor_spinor
@
\begin{equation}
\bar\psi\psi'
\end{equation}
NB: [[dot_product]] conjugates its first argument, we can either
cancel this or inline [[dot_product]]:
<<Implementation of operations for spinors>>=
pure function conjspinor_spinor (psibar, psi) result (psibarpsi)
complex(kind=default) :: psibarpsi
type(conjspinor), intent(in) :: psibar
type(spinor), intent(in) :: psi
psibarpsi = psibar%a(1)*psi%a(1) + psibar%a(2)*psi%a(2) &
+ psibar%a(3)*psi%a(3) + psibar%a(4)*psi%a(4)
end function conjspinor_spinor
@
\subsection{Spinor Vector Space}
\subsubsection{Scalar Multiplication}
<<Declaration of operations for spinors>>=
interface operator (*)
module procedure integer_spinor, spinor_integer, &
real_spinor, double_spinor, &
complex_spinor, dcomplex_spinor, &
spinor_real, spinor_double, &
spinor_complex, spinor_dcomplex
end interface
private :: integer_spinor, spinor_integer, real_spinor, &
double_spinor, complex_spinor, dcomplex_spinor, &
spinor_real, spinor_double, spinor_complex, spinor_dcomplex
@
<<Implementation of operations for spinors>>=
pure function integer_spinor (x, y) result (xy)
integer, intent(in) :: x
type(spinor), intent(in) :: y
type(spinor) :: xy
xy%a = x * y%a
end function integer_spinor
@
<<Implementation of operations for spinors>>=
pure function real_spinor (x, y) result (xy)
real(kind=single), intent(in) :: x
type(spinor), intent(in) :: y
type(spinor) :: xy
xy%a = x * y%a
end function real_spinor
pure function double_spinor (x, y) result (xy)
real(kind=default), intent(in) :: x
type(spinor), intent(in) :: y
type(spinor) :: xy
xy%a = x * y%a
end function double_spinor
pure function complex_spinor (x, y) result (xy)
complex(kind=single), intent(in) :: x
type(spinor), intent(in) :: y
type(spinor) :: xy
xy%a = x * y%a
end function complex_spinor
pure function dcomplex_spinor (x, y) result (xy)
complex(kind=default), intent(in) :: x
type(spinor), intent(in) :: y
type(spinor) :: xy
xy%a = x * y%a
end function dcomplex_spinor
pure function spinor_integer (y, x) result (xy)
integer, intent(in) :: x
type(spinor), intent(in) :: y
type(spinor) :: xy
xy%a = x * y%a
end function spinor_integer
pure function spinor_real (y, x) result (xy)
real(kind=single), intent(in) :: x
type(spinor), intent(in) :: y
type(spinor) :: xy
xy%a = x * y%a
end function spinor_real
pure function spinor_double (y, x) result (xy)
real(kind=default), intent(in) :: x
type(spinor), intent(in) :: y
type(spinor) :: xy
xy%a = x * y%a
end function spinor_double
pure function spinor_complex (y, x) result (xy)
complex(kind=single), intent(in) :: x
type(spinor), intent(in) :: y
type(spinor) :: xy
xy%a = x * y%a
end function spinor_complex
pure function spinor_dcomplex (y, x) result (xy)
complex(kind=default), intent(in) :: x
type(spinor), intent(in) :: y
type(spinor) :: xy
xy%a = x * y%a
end function spinor_dcomplex
@
<<Declaration of operations for spinors>>=
interface operator (*)
module procedure integer_conjspinor, conjspinor_integer, &
real_conjspinor, double_conjspinor, &
complex_conjspinor, dcomplex_conjspinor, &
conjspinor_real, conjspinor_double, &
conjspinor_complex, conjspinor_dcomplex
end interface
private :: integer_conjspinor, conjspinor_integer, real_conjspinor, &
double_conjspinor, complex_conjspinor, dcomplex_conjspinor, &
conjspinor_real, conjspinor_double, conjspinor_complex, &
conjspinor_dcomplex
@
<<Implementation of operations for spinors>>=
pure function integer_conjspinor (x, y) result (xy)
integer, intent(in) :: x
type(conjspinor), intent(in) :: y
type(conjspinor) :: xy
xy%a = x * y%a
end function integer_conjspinor
pure function real_conjspinor (x, y) result (xy)
real(kind=single), intent(in) :: x
type(conjspinor), intent(in) :: y
type(conjspinor) :: xy
xy%a = x * y%a
end function real_conjspinor
pure function double_conjspinor (x, y) result (xy)
real(kind=default), intent(in) :: x
type(conjspinor), intent(in) :: y
type(conjspinor) :: xy
xy%a = x * y%a
end function double_conjspinor
pure function complex_conjspinor (x, y) result (xy)
complex(kind=single), intent(in) :: x
type(conjspinor), intent(in) :: y
type(conjspinor) :: xy
xy%a = x * y%a
end function complex_conjspinor
pure function dcomplex_conjspinor (x, y) result (xy)
complex(kind=default), intent(in) :: x
type(conjspinor), intent(in) :: y
type(conjspinor) :: xy
xy%a = x * y%a
end function dcomplex_conjspinor
pure function conjspinor_integer (y, x) result (xy)
integer, intent(in) :: x
type(conjspinor), intent(in) :: y
type(conjspinor) :: xy
xy%a = x * y%a
end function conjspinor_integer
pure function conjspinor_real (y, x) result (xy)
real(kind=single), intent(in) :: x
type(conjspinor), intent(in) :: y
type(conjspinor) :: xy
xy%a = x * y%a
end function conjspinor_real
pure function conjspinor_double (y, x) result (xy)
real(kind=default), intent(in) :: x
type(conjspinor), intent(in) :: y
type(conjspinor) :: xy
xy%a = x * y%a
end function conjspinor_double
pure function conjspinor_complex (y, x) result (xy)
complex(kind=single), intent(in) :: x
type(conjspinor), intent(in) :: y
type(conjspinor) :: xy
xy%a = x * y%a
end function conjspinor_complex
pure function conjspinor_dcomplex (y, x) result (xy)
complex(kind=default), intent(in) :: x
type(conjspinor), intent(in) :: y
type(conjspinor) :: xy
xy%a = x * y%a
end function conjspinor_dcomplex
@
\subsubsection{Unary Plus and Minus}
<<Declaration of operations for spinors>>=
interface operator (+)
module procedure plus_spinor, plus_conjspinor
end interface
private :: plus_spinor, plus_conjspinor
interface operator (-)
module procedure neg_spinor, neg_conjspinor
end interface
private :: neg_spinor, neg_conjspinor
@
<<Implementation of operations for spinors>>=
pure function plus_spinor (x) result (plus_x)
type(spinor), intent(in) :: x
type(spinor) :: plus_x
plus_x%a = x%a
end function plus_spinor
pure function neg_spinor (x) result (neg_x)
type(spinor), intent(in) :: x
type(spinor) :: neg_x
neg_x%a = - x%a
end function neg_spinor
@
<<Implementation of operations for spinors>>=
pure function plus_conjspinor (x) result (plus_x)
type(conjspinor), intent(in) :: x
type(conjspinor) :: plus_x
plus_x%a = x%a
end function plus_conjspinor
pure function neg_conjspinor (x) result (neg_x)
type(conjspinor), intent(in) :: x
type(conjspinor) :: neg_x
neg_x%a = - x%a
end function neg_conjspinor
@
\subsubsection{Addition and Subtraction}
<<Declaration of operations for spinors>>=
interface operator (+)
module procedure add_spinor, add_conjspinor
end interface
private :: add_spinor, add_conjspinor
interface operator (-)
module procedure sub_spinor, sub_conjspinor
end interface
private :: sub_spinor, sub_conjspinor
@
<<Implementation of operations for spinors>>=
pure function add_spinor (x, y) result (xy)
type(spinor), intent(in) :: x, y
type(spinor) :: xy
xy%a = x%a + y%a
end function add_spinor
pure function sub_spinor (x, y) result (xy)
type(spinor), intent(in) :: x, y
type(spinor) :: xy
xy%a = x%a - y%a
end function sub_spinor
@
<<Implementation of operations for spinors>>=
pure function add_conjspinor (x, y) result (xy)
type(conjspinor), intent(in) :: x, y
type(conjspinor) :: xy
xy%a = x%a + y%a
end function add_conjspinor
pure function sub_conjspinor (x, y) result (xy)
type(conjspinor), intent(in) :: x, y
type(conjspinor) :: xy
xy%a = x%a - y%a
end function sub_conjspinor
@
\subsection{Norm}
<<Declaration of operations for spinors>>=
interface abs
module procedure abs_spinor, abs_conjspinor
end interface
private :: abs_spinor, abs_conjspinor
@
<<Implementation of operations for spinors>>=
pure function abs_spinor (psi) result (x)
type(spinor), intent(in) :: psi
real(kind=default) :: x
x = sqrt (dot_product (psi%a, psi%a))
end function abs_spinor
@
<<Implementation of operations for spinors>>=
pure function abs_conjspinor (psibar) result (x)
real(kind=default) :: x
type(conjspinor), intent(in) :: psibar
x = sqrt (dot_product (psibar%a, psibar%a))
end function abs_conjspinor
@
\section{Spinors Revisited}
<<[[omega_bispinors.f90]]>>=
<<Copyleft>>
module omega_bispinors
use kinds
use constants
implicit none
private
public :: operator (*), operator (+), operator (-)
public :: abs
type, public :: bispinor
! private (omegalib needs access, but DON'T TOUCH IT!)
complex(kind=default), dimension(4) :: a
end type bispinor
<<Declaration of operations for bispinors>>
integer, parameter, public :: omega_bispinors_2010_01_A = 0
contains
<<Implementation of operations for bispinors>>
end module omega_bispinors
@
<<Declaration of operations for bispinors>>=
interface operator (*)
module procedure spinor_product
end interface
private :: spinor_product
@
\begin{equation}
\bar\psi\psi'
\end{equation}
NB: [[dot_product]] conjugates its first argument, we have to cancel this.
<<Implementation of operations for bispinors>>=
pure function spinor_product (psil, psir) result (psilpsir)
complex(kind=default) :: psilpsir
type(bispinor), intent(in) :: psil, psir
type(bispinor) :: psidum
psidum%a(1) = psir%a(2)
psidum%a(2) = - psir%a(1)
psidum%a(3) = - psir%a(4)
psidum%a(4) = psir%a(3)
psilpsir = dot_product (conjg (psil%a), psidum%a)
end function spinor_product
@
\subsection{Spinor Vector Space}
\subsubsection{Scalar Multiplication}
<<Declaration of operations for bispinors>>=
interface operator (*)
module procedure integer_bispinor, bispinor_integer, &
real_bispinor, double_bispinor, &
complex_bispinor, dcomplex_bispinor, &
bispinor_real, bispinor_double, &
bispinor_complex, bispinor_dcomplex
end interface
private :: integer_bispinor, bispinor_integer, real_bispinor, &
double_bispinor, complex_bispinor, dcomplex_bispinor, &
bispinor_real, bispinor_double, bispinor_complex, bispinor_dcomplex
@
<<Implementation of operations for bispinors>>=
pure function integer_bispinor (x, y) result (xy)
type(bispinor) :: xy
integer, intent(in) :: x
type(bispinor), intent(in) :: y
xy%a = x * y%a
end function integer_bispinor
@
<<Implementation of operations for bispinors>>=
pure function real_bispinor (x, y) result (xy)
type(bispinor) :: xy
real(kind=single), intent(in) :: x
type(bispinor), intent(in) :: y
xy%a = x * y%a
end function real_bispinor
@
<<Implementation of operations for bispinors>>=
pure function double_bispinor (x, y) result (xy)
type(bispinor) :: xy
real(kind=default), intent(in) :: x
type(bispinor), intent(in) :: y
xy%a = x * y%a
end function double_bispinor
@
<<Implementation of operations for bispinors>>=
pure function complex_bispinor (x, y) result (xy)
type(bispinor) :: xy
complex(kind=single), intent(in) :: x
type(bispinor), intent(in) :: y
xy%a = x * y%a
end function complex_bispinor
@
<<Implementation of operations for bispinors>>=
pure function dcomplex_bispinor (x, y) result (xy)
type(bispinor) :: xy
complex(kind=default), intent(in) :: x
type(bispinor), intent(in) :: y
xy%a = x * y%a
end function dcomplex_bispinor
@
<<Implementation of operations for bispinors>>=
pure function bispinor_integer (y, x) result (xy)
type(bispinor) :: xy
integer, intent(in) :: x
type(bispinor), intent(in) :: y
xy%a = x * y%a
end function bispinor_integer
@
<<Implementation of operations for bispinors>>=
pure function bispinor_real (y, x) result (xy)
type(bispinor) :: xy
real(kind=single), intent(in) :: x
type(bispinor), intent(in) :: y
xy%a = x * y%a
end function bispinor_real
@
<<Implementation of operations for bispinors>>=
pure function bispinor_double (y, x) result (xy)
type(bispinor) :: xy
real(kind=default), intent(in) :: x
type(bispinor), intent(in) :: y
xy%a = x * y%a
end function bispinor_double
@
<<Implementation of operations for bispinors>>=
pure function bispinor_complex (y, x) result (xy)
type(bispinor) :: xy
complex(kind=single), intent(in) :: x
type(bispinor), intent(in) :: y
xy%a = x * y%a
end function bispinor_complex
@
<<Implementation of operations for bispinors>>=
pure function bispinor_dcomplex (y, x) result (xy)
type(bispinor) :: xy
complex(kind=default), intent(in) :: x
type(bispinor), intent(in) :: y
xy%a = x * y%a
end function bispinor_dcomplex
@
\subsubsection{Unary Plus and Minus}
<<Declaration of operations for bispinors>>=
interface operator (+)
module procedure plus_bispinor
end interface
private :: plus_bispinor
interface operator (-)
module procedure neg_bispinor
end interface
private :: neg_bispinor
@
<<Implementation of operations for bispinors>>=
pure function plus_bispinor (x) result (plus_x)
type(bispinor) :: plus_x
type(bispinor), intent(in) :: x
plus_x%a = x%a
end function plus_bispinor
@
<<Implementation of operations for bispinors>>=
pure function neg_bispinor (x) result (neg_x)
type(bispinor) :: neg_x
type(bispinor), intent(in) :: x
neg_x%a = - x%a
end function neg_bispinor
@
\subsubsection{Addition and Subtraction}
<<Declaration of operations for bispinors>>=
interface operator (+)
module procedure add_bispinor
end interface
private :: add_bispinor
interface operator (-)
module procedure sub_bispinor
end interface
private :: sub_bispinor
@
<<Implementation of operations for bispinors>>=
pure function add_bispinor (x, y) result (xy)
type(bispinor) :: xy
type(bispinor), intent(in) :: x, y
xy%a = x%a + y%a
end function add_bispinor
@
<<Implementation of operations for bispinors>>=
pure function sub_bispinor (x, y) result (xy)
type(bispinor) :: xy
type(bispinor), intent(in) :: x, y
xy%a = x%a - y%a
end function sub_bispinor
@
\subsection{Norm}
<<Declaration of operations for bispinors>>=
interface abs
module procedure abs_bispinor
end interface
private :: abs_bispinor
@
<<Implementation of operations for bispinors>>=
pure function abs_bispinor (psi) result (x)
real(kind=default) :: x
type(bispinor), intent(in) :: psi
x = sqrt (dot_product (psi%a, psi%a))
end function abs_bispinor
@
\section{Vectorspinors}
<<[[omega_vectorspinors.f90]]>>=
<<Copyleft>>
module omega_vectorspinors
use kinds
use constants
use omega_bispinors
use omega_vectors
implicit none
private
public :: operator (*), operator (+), operator (-)
public :: abs
type, public :: vectorspinor
! private (omegalib needs access, but DON'T TOUCH IT!)
type(bispinor), dimension(4) :: psi
end type vectorspinor
<<Declaration of operations for vectorspinors>>
integer, parameter, public :: omega_vectorspinors_2010_01_A = 0
contains
<<Implementation of operations for vectorspinors>>
end module omega_vectorspinors
@
<<Declaration of operations for vectorspinors>>=
interface operator (*)
module procedure vspinor_product
end interface
private :: vspinor_product
@
\begin{equation}
\bar\psi^\mu\psi'_\mu
\end{equation}
<<Implementation of operations for vectorspinors>>=
pure function vspinor_product (psil, psir) result (psilpsir)
complex(kind=default) :: psilpsir
type(vectorspinor), intent(in) :: psil, psir
psilpsir = psil%psi(1) * psir%psi(1) &
- psil%psi(2) * psir%psi(2) &
- psil%psi(3) * psir%psi(3) &
- psil%psi(4) * psir%psi(4)
end function vspinor_product
@
\subsection{Vectorspinor Vector Space}
\subsubsection{Scalar Multiplication}
<<Declaration of operations for vectorspinors>>=
interface operator (*)
module procedure integer_vectorspinor, vectorspinor_integer, &
real_vectorspinor, double_vectorspinor, &
complex_vectorspinor, dcomplex_vectorspinor, &
vectorspinor_real, vectorspinor_double, &
vectorspinor_complex, vectorspinor_dcomplex, &
momentum_vectorspinor, vectorspinor_momentum
end interface
private :: integer_vectorspinor, vectorspinor_integer, real_vectorspinor, &
double_vectorspinor, complex_vectorspinor, dcomplex_vectorspinor, &
vectorspinor_real, vectorspinor_double, vectorspinor_complex, &
vectorspinor_dcomplex
@
<<Implementation of operations for vectorspinors>>=
pure function integer_vectorspinor (x, y) result (xy)
type(vectorspinor) :: xy
integer, intent(in) :: x
type(vectorspinor), intent(in) :: y
integer :: k
do k = 1,4
xy%psi(k) = x * y%psi(k)
end do
end function integer_vectorspinor
@
<<Implementation of operations for vectorspinors>>=
pure function real_vectorspinor (x, y) result (xy)
type(vectorspinor) :: xy
real(kind=single), intent(in) :: x
type(vectorspinor), intent(in) :: y
integer :: k
do k = 1,4
xy%psi(k) = x * y%psi(k)
end do
end function real_vectorspinor
@
<<Implementation of operations for vectorspinors>>=
pure function double_vectorspinor (x, y) result (xy)
type(vectorspinor) :: xy
real(kind=default), intent(in) :: x
type(vectorspinor), intent(in) :: y
integer :: k
do k = 1,4
xy%psi(k) = x * y%psi(k)
end do
end function double_vectorspinor
@
<<Implementation of operations for vectorspinors>>=
pure function complex_vectorspinor (x, y) result (xy)
type(vectorspinor) :: xy
complex(kind=single), intent(in) :: x
type(vectorspinor), intent(in) :: y
integer :: k
do k = 1,4
xy%psi(k) = x * y%psi(k)
end do
end function complex_vectorspinor
@
<<Implementation of operations for vectorspinors>>=
pure function dcomplex_vectorspinor (x, y) result (xy)
type(vectorspinor) :: xy
complex(kind=default), intent(in) :: x
type(vectorspinor), intent(in) :: y
integer :: k
do k = 1,4
xy%psi(k) = x * y%psi(k)
end do
end function dcomplex_vectorspinor
@
<<Implementation of operations for vectorspinors>>=
pure function vectorspinor_integer (y, x) result (xy)
type(vectorspinor) :: xy
integer, intent(in) :: x
type(vectorspinor), intent(in) :: y
integer :: k
do k = 1,4
xy%psi(k) = y%psi(k) * x
end do
end function vectorspinor_integer
@
<<Implementation of operations for vectorspinors>>=
pure function vectorspinor_real (y, x) result (xy)
type(vectorspinor) :: xy
real(kind=single), intent(in) :: x
type(vectorspinor), intent(in) :: y
integer :: k
do k = 1,4
xy%psi(k) = y%psi(k) * x
end do
end function vectorspinor_real
@
<<Implementation of operations for vectorspinors>>=
pure function vectorspinor_double (y, x) result (xy)
type(vectorspinor) :: xy
real(kind=default), intent(in) :: x
type(vectorspinor), intent(in) :: y
integer :: k
do k = 1,4
xy%psi(k) = y%psi(k) * x
end do
end function vectorspinor_double
@
<<Implementation of operations for vectorspinors>>=
pure function vectorspinor_complex (y, x) result (xy)
type(vectorspinor) :: xy
complex(kind=single), intent(in) :: x
type(vectorspinor), intent(in) :: y
integer :: k
do k = 1,4
xy%psi(k) = y%psi(k) * x
end do
end function vectorspinor_complex
@
<<Implementation of operations for vectorspinors>>=
pure function vectorspinor_dcomplex (y, x) result (xy)
type(vectorspinor) :: xy
complex(kind=default), intent(in) :: x
type(vectorspinor), intent(in) :: y
integer :: k
do k = 1,4
xy%psi(k) = y%psi(k) * x
end do
end function vectorspinor_dcomplex
@
<<Implementation of operations for vectorspinors>>=
pure function momentum_vectorspinor (y, x) result (xy)
type(bispinor) :: xy
type(momentum), intent(in) :: y
type(vectorspinor), intent(in) :: x
integer :: k
do k = 1,4
xy%a(k) = y%t * x%psi(1)%a(k) - y%x(1) * x%psi(2)%a(k) - &
y%x(2) * x%psi(3)%a(k) - y%x(3) * x%psi(4)%a(k)
end do
end function momentum_vectorspinor
@
<<Implementation of operations for vectorspinors>>=
pure function vectorspinor_momentum (y, x) result (xy)
type(bispinor) :: xy
type(momentum), intent(in) :: x
type(vectorspinor), intent(in) :: y
integer :: k
do k = 1,4
xy%a(k) = x%t * y%psi(1)%a(k) - x%x(1) * y%psi(2)%a(k) - &
x%x(2) * y%psi(3)%a(k) - x%x(3) * y%psi(4)%a(k)
end do
end function vectorspinor_momentum
@
\subsubsection{Unary Plus and Minus}
<<Declaration of operations for vectorspinors>>=
interface operator (+)
module procedure plus_vectorspinor
end interface
private :: plus_vectorspinor
interface operator (-)
module procedure neg_vectorspinor
end interface
private :: neg_vectorspinor
@
<<Implementation of operations for vectorspinors>>=
pure function plus_vectorspinor (x) result (plus_x)
type(vectorspinor) :: plus_x
type(vectorspinor), intent(in) :: x
integer :: k
do k = 1,4
plus_x%psi(k) = + x%psi(k)
end do
end function plus_vectorspinor
@
<<Implementation of operations for vectorspinors>>=
pure function neg_vectorspinor (x) result (neg_x)
type(vectorspinor) :: neg_x
type(vectorspinor), intent(in) :: x
integer :: k
do k = 1,4
neg_x%psi(k) = - x%psi(k)
end do
end function neg_vectorspinor
@
\subsubsection{Addition and Subtraction}
<<Declaration of operations for vectorspinors>>=
interface operator (+)
module procedure add_vectorspinor
end interface
private :: add_vectorspinor
interface operator (-)
module procedure sub_vectorspinor
end interface
private :: sub_vectorspinor
@
<<Implementation of operations for vectorspinors>>=
pure function add_vectorspinor (x, y) result (xy)
type(vectorspinor) :: xy
type(vectorspinor), intent(in) :: x, y
integer :: k
do k = 1,4
xy%psi(k) = x%psi(k) + y%psi(k)
end do
end function add_vectorspinor
@
<<Implementation of operations for vectorspinors>>=
pure function sub_vectorspinor (x, y) result (xy)
type(vectorspinor) :: xy
type(vectorspinor), intent(in) :: x, y
integer :: k
do k = 1,4
xy%psi(k) = x%psi(k) - y%psi(k)
end do
end function sub_vectorspinor
@
\subsection{Norm}
<<Declaration of operations for vectorspinors>>=
interface abs
module procedure abs_vectorspinor
end interface
private :: abs_vectorspinor
@
<<Implementation of operations for vectorspinors>>=
pure function abs_vectorspinor (psi) result (x)
real(kind=default) :: x
type(vectorspinor), intent(in) :: psi
x = sqrt (dot_product (psi%psi(1)%a, psi%psi(1)%a) &
- dot_product (psi%psi(2)%a, psi%psi(2)%a) &
- dot_product (psi%psi(3)%a, psi%psi(3)%a) &
- dot_product (psi%psi(4)%a, psi%psi(4)%a))
end function abs_vectorspinor
@
\section{Vectors and Tensors}
Condensed representation of antisymmetric rank-2 tensors:
\begin{equation}
\begin{pmatrix}
T^{00} & T^{01} & T^{02} & T^{03} \\
T^{10} & T^{11} & T^{12} & T^{13} \\
T^{20} & T^{21} & T^{22} & T^{23} \\
T^{30} & T^{31} & T^{32} & T^{33}
\end{pmatrix}
=
\begin{pmatrix}
0 & T_e^1 & T_e^2 & T_e^3 \\
-T_e^1 & 0 & T_b^3 & -T_b^2 \\
-T_e^2 & -T_b^3 & 0 & T_b^1 \\
-T_e^3 & T_b^2 & -T_b^1 & 0
\end{pmatrix}
\end{equation}
<<[[omega_vectors.f90]]>>=
<<Copyleft>>
module omega_vectors
use kinds
use constants
implicit none
private
public :: assignment (=)
public :: operator (*), operator (+), operator (-), operator (.wedge.)
public :: abs, conjg
public :: random_momentum
<<[[intrinsic :: abs]]>>
<<[[intrinsic :: conjg]]>>
type, public :: momentum
! private (omegalib needs access, but DON'T TOUCH IT!)
real(kind=default) :: t
real(kind=default), dimension(3) :: x
end type momentum
type, public :: vector
! private (omegalib needs access, but DON'T TOUCH IT!)
complex(kind=default) :: t
complex(kind=default), dimension(3) :: x
end type vector
type, public :: tensor2odd
! private (omegalib needs access, but DON'T TOUCH IT!)
complex(kind=default), dimension(3) :: e
complex(kind=default), dimension(3) :: b
end type tensor2odd
<<Declaration of operations for vectors>>
integer, parameter, public :: omega_vectors_2010_01_A = 0
contains
<<Implementation of operations for vectors>>
end module omega_vectors
@
\subsection{Constructors}
<<Declaration of operations for vectors>>=
interface assignment (=)
module procedure momentum_of_array, vector_of_momentum, &
vector_of_array, vector_of_double_array, &
array_of_momentum, array_of_vector
end interface
private :: momentum_of_array, vector_of_momentum, vector_of_array, &
vector_of_double_array, array_of_momentum, array_of_vector
@
<<Implementation of operations for vectors>>=
pure subroutine momentum_of_array (m, p)
type(momentum), intent(out) :: m
real(kind=default), dimension(0:), intent(in) :: p
m%t = p(0)
m%x = p(1:3)
end subroutine momentum_of_array
pure subroutine array_of_momentum (p, v)
real(kind=default), dimension(0:), intent(out) :: p
type(momentum), intent(in) :: v
p(0) = v%t
p(1:3) = v%x
end subroutine array_of_momentum
@
<<Implementation of operations for vectors>>=
pure subroutine vector_of_array (v, p)
type(vector), intent(out) :: v
complex(kind=default), dimension(0:), intent(in) :: p
v%t = p(0)
v%x = p(1:3)
end subroutine vector_of_array
pure subroutine vector_of_double_array (v, p)
type(vector), intent(out) :: v
real(kind=default), dimension(0:), intent(in) :: p
v%t = p(0)
v%x = p(1:3)
end subroutine vector_of_double_array
pure subroutine array_of_vector (p, v)
complex(kind=default), dimension(0:), intent(out) :: p
type(vector), intent(in) :: v
p(0) = v%t
p(1:3) = v%x
end subroutine array_of_vector
@
<<Implementation of operations for vectors>>=
pure subroutine vector_of_momentum (v, p)
type(vector), intent(out) :: v
type(momentum), intent(in) :: p
v%t = p%t
v%x = p%x
end subroutine vector_of_momentum
@
\subsection{Inner Products}
<<Declaration of operations for vectors>>=
interface operator (*)
module procedure momentum_momentum, vector_vector, &
vector_momentum, momentum_vector, tensor2odd_tensor2odd
end interface
private :: momentum_momentum, vector_vector, vector_momentum, &
momentum_vector, tensor2odd_tensor2odd
@
<<Implementation of operations for vectors>>=
pure function momentum_momentum (x, y) result (xy)
type(momentum), intent(in) :: x
type(momentum), intent(in) :: y
real(kind=default) :: xy
xy = x%t*y%t - x%x(1)*y%x(1) - x%x(2)*y%x(2) - x%x(3)*y%x(3)
end function momentum_momentum
pure function momentum_vector (x, y) result (xy)
type(momentum), intent(in) :: x
type(vector), intent(in) :: y
complex(kind=default) :: xy
xy = x%t*y%t - x%x(1)*y%x(1) - x%x(2)*y%x(2) - x%x(3)*y%x(3)
end function momentum_vector
pure function vector_momentum (x, y) result (xy)
type(vector), intent(in) :: x
type(momentum), intent(in) :: y
complex(kind=default) :: xy
xy = x%t*y%t - x%x(1)*y%x(1) - x%x(2)*y%x(2) - x%x(3)*y%x(3)
end function vector_momentum
pure function vector_vector (x, y) result (xy)
type(vector), intent(in) :: x
type(vector), intent(in) :: y
complex(kind=default) :: xy
xy = x%t*y%t - x%x(1)*y%x(1) - x%x(2)*y%x(2) - x%x(3)*y%x(3)
end function vector_vector
@
Just like classical electrodynamics:
\begin{equation}
\frac{1}{2} T_{\mu\nu} U^{\mu\nu}
= \frac{1}{2} \left( - T^{0i} U^{0i} - T^{i0} U^{i0} + T^{ij} U^{ij} \right)
= T_b^k U_b^k - T_e^k U_e^k
\end{equation}
<<Implementation of operations for vectors>>=
pure function tensor2odd_tensor2odd (x, y) result (xy)
type(tensor2odd), intent(in) :: x
type(tensor2odd), intent(in) :: y
complex(kind=default) :: xy
xy = x%b(1)*y%b(1) + x%b(2)*y%b(2) + x%b(3)*y%b(3) &
- x%e(1)*y%e(1) - x%e(2)*y%e(2) - x%e(3)*y%e(3)
end function tensor2odd_tensor2odd
@
\subsection{Not Entirely Inner Products}
<<Declaration of operations for vectors>>=
interface operator (*)
module procedure momentum_tensor2odd, tensor2odd_momentum, &
vector_tensor2odd, tensor2odd_vector
end interface
private :: momentum_tensor2odd, tensor2odd_momentum, vector_tensor2odd, &
tensor2odd_vector
@
\begin{subequations}
\begin{align}
y^\nu = x_\mu T^{\mu\nu}:
& y^0 = - x^i T^{i0} = x^i T^{0i} \\
& y^1 = x^0 T^{01} - x^2 T^{21} - x^3 T^{31} \\
& y^2 = x^0 T^{02} - x^1 T^{12} - x^3 T^{32} \\
& y^3 = x^0 T^{03} - x^1 T^{13} - x^2 T^{23}
\end{align}
\end{subequations}
<<Implementation of operations for vectors>>=
pure function vector_tensor2odd (x, t2) result (xt2)
type(vector), intent(in) :: x
type(tensor2odd), intent(in) :: t2
type(vector) :: xt2
xt2%t = x%x(1)*t2%e(1) + x%x(2)*t2%e(2) + x%x(3)*t2%e(3)
xt2%x(1) = x%t*t2%e(1) + x%x(2)*t2%b(3) - x%x(3)*t2%b(2)
xt2%x(2) = x%t*t2%e(2) + x%x(3)*t2%b(1) - x%x(1)*t2%b(3)
xt2%x(3) = x%t*t2%e(3) + x%x(1)*t2%b(2) - x%x(2)*t2%b(1)
end function vector_tensor2odd
pure function momentum_tensor2odd (x, t2) result (xt2)
type(momentum), intent(in) :: x
type(tensor2odd), intent(in) :: t2
type(vector) :: xt2
xt2%t = x%x(1)*t2%e(1) + x%x(2)*t2%e(2) + x%x(3)*t2%e(3)
xt2%x(1) = x%t*t2%e(1) + x%x(2)*t2%b(3) - x%x(3)*t2%b(2)
xt2%x(2) = x%t*t2%e(2) + x%x(3)*t2%b(1) - x%x(1)*t2%b(3)
xt2%x(3) = x%t*t2%e(3) + x%x(1)*t2%b(2) - x%x(2)*t2%b(1)
end function momentum_tensor2odd
@
\begin{subequations}
\begin{align}
y^\mu = T^{\mu\nu} x_\nu :
& y^0 = - T^{0i} x^i \\
& y^1 = T^{10} x^0 - T^{12} x^2 - T^{13} x^3 \\
& y^2 = T^{20} x^0 - T^{21} x^1 - T^{23} x^3 \\
& y^3 = T^{30} x^0 - T^{31} x^1 - T^{32} x^2
\end{align}
\end{subequations}
<<Implementation of operations for vectors>>=
pure function tensor2odd_vector (t2, x) result (t2x)
type(tensor2odd), intent(in) :: t2
type(vector), intent(in) :: x
type(vector) :: t2x
t2x%t = - t2%e(1)*x%x(1) - t2%e(2)*x%x(2) - t2%e(3)*x%x(3)
t2x%x(1) = - t2%e(1)*x%t + t2%b(2)*x%x(3) - t2%b(3)*x%x(2)
t2x%x(2) = - t2%e(2)*x%t + t2%b(3)*x%x(1) - t2%b(1)*x%x(3)
t2x%x(3) = - t2%e(3)*x%t + t2%b(1)*x%x(2) - t2%b(2)*x%x(1)
end function tensor2odd_vector
pure function tensor2odd_momentum (t2, x) result (t2x)
type(tensor2odd), intent(in) :: t2
type(momentum), intent(in) :: x
type(vector) :: t2x
t2x%t = - t2%e(1)*x%x(1) - t2%e(2)*x%x(2) - t2%e(3)*x%x(3)
t2x%x(1) = - t2%e(1)*x%t + t2%b(2)*x%x(3) - t2%b(3)*x%x(2)
t2x%x(2) = - t2%e(2)*x%t + t2%b(3)*x%x(1) - t2%b(1)*x%x(3)
t2x%x(3) = - t2%e(3)*x%t + t2%b(1)*x%x(2) - t2%b(2)*x%x(1)
end function tensor2odd_momentum
@
\subsection{Outer Products}
<<Declaration of operations for vectors>>=
interface operator (.wedge.)
module procedure momentum_wedge_momentum, &
momentum_wedge_vector, vector_wedge_momentum, vector_wedge_vector
end interface
private :: momentum_wedge_momentum, momentum_wedge_vector, &
vector_wedge_momentum, vector_wedge_vector
@
<<Implementation of operations for vectors>>=
pure function momentum_wedge_momentum (x, y) result (t2)
type(momentum), intent(in) :: x
type(momentum), intent(in) :: y
type(tensor2odd) :: t2
t2%e = x%t * y%x - x%x * y%t
t2%b(1) = x%x(2) * y%x(3) - x%x(3) * y%x(2)
t2%b(2) = x%x(3) * y%x(1) - x%x(1) * y%x(3)
t2%b(3) = x%x(1) * y%x(2) - x%x(2) * y%x(1)
end function momentum_wedge_momentum
pure function momentum_wedge_vector (x, y) result (t2)
type(momentum), intent(in) :: x
type(vector), intent(in) :: y
type(tensor2odd) :: t2
t2%e = x%t * y%x - x%x * y%t
t2%b(1) = x%x(2) * y%x(3) - x%x(3) * y%x(2)
t2%b(2) = x%x(3) * y%x(1) - x%x(1) * y%x(3)
t2%b(3) = x%x(1) * y%x(2) - x%x(2) * y%x(1)
end function momentum_wedge_vector
pure function vector_wedge_momentum (x, y) result (t2)
type(vector), intent(in) :: x
type(momentum), intent(in) :: y
type(tensor2odd) :: t2
t2%e = x%t * y%x - x%x * y%t
t2%b(1) = x%x(2) * y%x(3) - x%x(3) * y%x(2)
t2%b(2) = x%x(3) * y%x(1) - x%x(1) * y%x(3)
t2%b(3) = x%x(1) * y%x(2) - x%x(2) * y%x(1)
end function vector_wedge_momentum
pure function vector_wedge_vector (x, y) result (t2)
type(vector), intent(in) :: x
type(vector), intent(in) :: y
type(tensor2odd) :: t2
t2%e = x%t * y%x - x%x * y%t
t2%b(1) = x%x(2) * y%x(3) - x%x(3) * y%x(2)
t2%b(2) = x%x(3) * y%x(1) - x%x(1) * y%x(3)
t2%b(3) = x%x(1) * y%x(2) - x%x(2) * y%x(1)
end function vector_wedge_vector
@
\subsection{Vector Space}
\subsubsection{Scalar Multiplication}
<<Declaration of operations for vectors>>=
interface operator (*)
module procedure integer_momentum, real_momentum, double_momentum, &
complex_momentum, dcomplex_momentum, &
integer_vector, real_vector, double_vector, &
complex_vector, dcomplex_vector, &
integer_tensor2odd, real_tensor2odd, double_tensor2odd, &
complex_tensor2odd, dcomplex_tensor2odd, &
momentum_integer, momentum_real, momentum_double, &
momentum_complex, momentum_dcomplex, &
vector_integer, vector_real, vector_double, &
vector_complex, vector_dcomplex, &
tensor2odd_integer, tensor2odd_real, tensor2odd_double, &
tensor2odd_complex, tensor2odd_dcomplex
end interface
private :: integer_momentum, real_momentum, double_momentum, &
complex_momentum, dcomplex_momentum, integer_vector, real_vector, &
double_vector, complex_vector, dcomplex_vector, &
integer_tensor2odd, real_tensor2odd, double_tensor2odd, &
complex_tensor2odd, dcomplex_tensor2odd, momentum_integer, &
momentum_real, momentum_double, momentum_complex, &
momentum_dcomplex, vector_integer, vector_real, vector_double, &
vector_complex, vector_dcomplex, tensor2odd_integer, &
tensor2odd_real, tensor2odd_double, tensor2odd_complex, &
tensor2odd_dcomplex
@
<<Implementation of operations for vectors>>=
pure function integer_momentum (x, y) result (xy)
integer, intent(in) :: x
type(momentum), intent(in) :: y
type(momentum) :: xy
xy%t = x * y%t
xy%x = x * y%x
end function integer_momentum
pure function real_momentum (x, y) result (xy)
real(kind=single), intent(in) :: x
type(momentum), intent(in) :: y
type(momentum) :: xy
xy%t = x * y%t
xy%x = x * y%x
end function real_momentum
pure function double_momentum (x, y) result (xy)
real(kind=default), intent(in) :: x
type(momentum), intent(in) :: y
type(momentum) :: xy
xy%t = x * y%t
xy%x = x * y%x
end function double_momentum
pure function complex_momentum (x, y) result (xy)
complex(kind=single), intent(in) :: x
type(momentum), intent(in) :: y
type(vector) :: xy
xy%t = x * y%t
xy%x = x * y%x
end function complex_momentum
pure function dcomplex_momentum (x, y) result (xy)
complex(kind=default), intent(in) :: x
type(momentum), intent(in) :: y
type(vector) :: xy
xy%t = x * y%t
xy%x = x * y%x
end function dcomplex_momentum
@
<<Implementation of operations for vectors>>=
pure function integer_vector (x, y) result (xy)
integer, intent(in) :: x
type(vector), intent(in) :: y
type(vector) :: xy
xy%t = x * y%t
xy%x = x * y%x
end function integer_vector
pure function real_vector (x, y) result (xy)
real(kind=single), intent(in) :: x
type(vector), intent(in) :: y
type(vector) :: xy
xy%t = x * y%t
xy%x = x * y%x
end function real_vector
pure function double_vector (x, y) result (xy)
real(kind=default), intent(in) :: x
type(vector), intent(in) :: y
type(vector) :: xy
xy%t = x * y%t
xy%x = x * y%x
end function double_vector
pure function complex_vector (x, y) result (xy)
complex(kind=single), intent(in) :: x
type(vector), intent(in) :: y
type(vector) :: xy
xy%t = x * y%t
xy%x = x * y%x
end function complex_vector
pure function dcomplex_vector (x, y) result (xy)
complex(kind=default), intent(in) :: x
type(vector), intent(in) :: y
type(vector) :: xy
xy%t = x * y%t
xy%x = x * y%x
end function dcomplex_vector
@
<<Implementation of operations for vectors>>=
pure function integer_tensor2odd (x, t2) result (xt2)
integer, intent(in) :: x
type(tensor2odd), intent(in) :: t2
type(tensor2odd) :: xt2
xt2%e = x * t2%e
xt2%b = x * t2%b
end function integer_tensor2odd
pure function real_tensor2odd (x, t2) result (xt2)
real(kind=single), intent(in) :: x
type(tensor2odd), intent(in) :: t2
type(tensor2odd) :: xt2
xt2%e = x * t2%e
xt2%b = x * t2%b
end function real_tensor2odd
pure function double_tensor2odd (x, t2) result (xt2)
real(kind=default), intent(in) :: x
type(tensor2odd), intent(in) :: t2
type(tensor2odd) :: xt2
xt2%e = x * t2%e
xt2%b = x * t2%b
end function double_tensor2odd
pure function complex_tensor2odd (x, t2) result (xt2)
complex(kind=single), intent(in) :: x
type(tensor2odd), intent(in) :: t2
type(tensor2odd) :: xt2
xt2%e = x * t2%e
xt2%b = x * t2%b
end function complex_tensor2odd
pure function dcomplex_tensor2odd (x, t2) result (xt2)
complex(kind=default), intent(in) :: x
type(tensor2odd), intent(in) :: t2
type(tensor2odd) :: xt2
xt2%e = x * t2%e
xt2%b = x * t2%b
end function dcomplex_tensor2odd
@
<<Implementation of operations for vectors>>=
pure function momentum_integer (y, x) result (xy)
integer, intent(in) :: x
type(momentum), intent(in) :: y
type(momentum) :: xy
xy%t = x * y%t
xy%x = x * y%x
end function momentum_integer
pure function momentum_real (y, x) result (xy)
real(kind=single), intent(in) :: x
type(momentum), intent(in) :: y
type(momentum) :: xy
xy%t = x * y%t
xy%x = x * y%x
end function momentum_real
pure function momentum_double (y, x) result (xy)
real(kind=default), intent(in) :: x
type(momentum), intent(in) :: y
type(momentum) :: xy
xy%t = x * y%t
xy%x = x * y%x
end function momentum_double
pure function momentum_complex (y, x) result (xy)
complex(kind=single), intent(in) :: x
type(momentum), intent(in) :: y
type(vector) :: xy
xy%t = x * y%t
xy%x = x * y%x
end function momentum_complex
pure function momentum_dcomplex (y, x) result (xy)
complex(kind=default), intent(in) :: x
type(momentum), intent(in) :: y
type(vector) :: xy
xy%t = x * y%t
xy%x = x * y%x
end function momentum_dcomplex
@
<<Implementation of operations for vectors>>=
pure function vector_integer (y, x) result (xy)
integer, intent(in) :: x
type(vector), intent(in) :: y
type(vector) :: xy
xy%t = x * y%t
xy%x = x * y%x
end function vector_integer
pure function vector_real (y, x) result (xy)
real(kind=single), intent(in) :: x
type(vector), intent(in) :: y
type(vector) :: xy
xy%t = x * y%t
xy%x = x * y%x
end function vector_real
pure function vector_double (y, x) result (xy)
real(kind=default), intent(in) :: x
type(vector), intent(in) :: y
type(vector) :: xy
xy%t = x * y%t
xy%x = x * y%x
end function vector_double
pure function vector_complex (y, x) result (xy)
complex(kind=single), intent(in) :: x
type(vector), intent(in) :: y
type(vector) :: xy
xy%t = x * y%t
xy%x = x * y%x
end function vector_complex
pure function vector_dcomplex (y, x) result (xy)
complex(kind=default), intent(in) :: x
type(vector), intent(in) :: y
type(vector) :: xy
xy%t = x * y%t
xy%x = x * y%x
end function vector_dcomplex
@
<<Implementation of operations for vectors>>=
pure function tensor2odd_integer (t2, x) result (t2x)
type(tensor2odd), intent(in) :: t2
integer, intent(in) :: x
type(tensor2odd) :: t2x
t2x%e = x * t2%e
t2x%b = x * t2%b
end function tensor2odd_integer
pure function tensor2odd_real (t2, x) result (t2x)
type(tensor2odd), intent(in) :: t2
real(kind=single), intent(in) :: x
type(tensor2odd) :: t2x
t2x%e = x * t2%e
t2x%b = x * t2%b
end function tensor2odd_real
pure function tensor2odd_double (t2, x) result (t2x)
type(tensor2odd), intent(in) :: t2
real(kind=default), intent(in) :: x
type(tensor2odd) :: t2x
t2x%e = x * t2%e
t2x%b = x * t2%b
end function tensor2odd_double
pure function tensor2odd_complex (t2, x) result (t2x)
type(tensor2odd), intent(in) :: t2
complex(kind=single), intent(in) :: x
type(tensor2odd) :: t2x
t2x%e = x * t2%e
t2x%b = x * t2%b
end function tensor2odd_complex
pure function tensor2odd_dcomplex (t2, x) result (t2x)
type(tensor2odd), intent(in) :: t2
complex(kind=default), intent(in) :: x
type(tensor2odd) :: t2x
t2x%e = x * t2%e
t2x%b = x * t2%b
end function tensor2odd_dcomplex
@
\subsubsection{Unary Plus and Minus}
<<Declaration of operations for vectors>>=
interface operator (+)
module procedure plus_momentum, plus_vector, plus_tensor2odd
end interface
private :: plus_momentum, plus_vector, plus_tensor2odd
interface operator (-)
module procedure neg_momentum, neg_vector, neg_tensor2odd
end interface
private :: neg_momentum, neg_vector, neg_tensor2odd
@
<<Implementation of operations for vectors>>=
pure function plus_momentum (x) result (plus_x)
type(momentum), intent(in) :: x
type(momentum) :: plus_x
plus_x = x
end function plus_momentum
pure function neg_momentum (x) result (neg_x)
type(momentum), intent(in) :: x
type(momentum) :: neg_x
neg_x%t = - x%t
neg_x%x = - x%x
end function neg_momentum
@
<<Implementation of operations for vectors>>=
pure function plus_vector (x) result (plus_x)
type(vector), intent(in) :: x
type(vector) :: plus_x
plus_x = x
end function plus_vector
pure function neg_vector (x) result (neg_x)
type(vector), intent(in) :: x
type(vector) :: neg_x
neg_x%t = - x%t
neg_x%x = - x%x
end function neg_vector
@
<<Implementation of operations for vectors>>=
pure function plus_tensor2odd (x) result (plus_x)
type(tensor2odd), intent(in) :: x
type(tensor2odd) :: plus_x
plus_x = x
end function plus_tensor2odd
pure function neg_tensor2odd (x) result (neg_x)
type(tensor2odd), intent(in) :: x
type(tensor2odd) :: neg_x
neg_x%e = - x%e
neg_x%b = - x%b
end function neg_tensor2odd
@
\subsubsection{Addition and Subtraction}
<<Declaration of operations for vectors>>=
interface operator (+)
module procedure add_momentum, add_vector, &
add_vector_momentum, add_momentum_vector, add_tensor2odd
end interface
private :: add_momentum, add_vector, add_vector_momentum, &
add_momentum_vector, add_tensor2odd
interface operator (-)
module procedure sub_momentum, sub_vector, &
sub_vector_momentum, sub_momentum_vector, sub_tensor2odd
end interface
private :: sub_momentum, sub_vector, sub_vector_momentum, &
sub_momentum_vector, sub_tensor2odd
@
<<Implementation of operations for vectors>>=
pure function add_momentum (x, y) result (xy)
type(momentum), intent(in) :: x, y
type(momentum) :: xy
xy%t = x%t + y%t
xy%x = x%x + y%x
end function add_momentum
pure function add_vector (x, y) result (xy)
type(vector), intent(in) :: x, y
type(vector) :: xy
xy%t = x%t + y%t
xy%x = x%x + y%x
end function add_vector
pure function add_momentum_vector (x, y) result (xy)
type(momentum), intent(in) :: x
type(vector), intent(in) :: y
type(vector) :: xy
xy%t = x%t + y%t
xy%x = x%x + y%x
end function add_momentum_vector
pure function add_vector_momentum (x, y) result (xy)
type(vector), intent(in) :: x
type(momentum), intent(in) :: y
type(vector) :: xy
xy%t = x%t + y%t
xy%x = x%x + y%x
end function add_vector_momentum
pure function add_tensor2odd (x, y) result (xy)
type(tensor2odd), intent(in) :: x, y
type(tensor2odd) :: xy
xy%e = x%e + y%e
xy%b = x%b + y%b
end function add_tensor2odd
@
<<Implementation of operations for vectors>>=
pure function sub_momentum (x, y) result (xy)
type(momentum), intent(in) :: x, y
type(momentum) :: xy
xy%t = x%t - y%t
xy%x = x%x - y%x
end function sub_momentum
pure function sub_vector (x, y) result (xy)
type(vector), intent(in) :: x, y
type(vector) :: xy
xy%t = x%t - y%t
xy%x = x%x - y%x
end function sub_vector
pure function sub_momentum_vector (x, y) result (xy)
type(momentum), intent(in) :: x
type(vector), intent(in) :: y
type(vector) :: xy
xy%t = x%t - y%t
xy%x = x%x - y%x
end function sub_momentum_vector
pure function sub_vector_momentum (x, y) result (xy)
type(vector), intent(in) :: x
type(momentum), intent(in) :: y
type(vector) :: xy
xy%t = x%t - y%t
xy%x = x%x - y%x
end function sub_vector_momentum
pure function sub_tensor2odd (x, y) result (xy)
type(tensor2odd), intent(in) :: x, y
type(tensor2odd) :: xy
xy%e = x%e - y%e
xy%b = x%b - y%b
end function sub_tensor2odd
@
\subsection{Norm}
\emph{Not} the covariant length!
<<Declaration of operations for vectors>>=
interface abs
module procedure abs_momentum, abs_vector, abs_tensor2odd
end interface
private :: abs_momentum, abs_vector, abs_tensor2odd
@
<<Implementation of operations for vectors>>=
pure function abs_momentum (x) result (absx)
type(momentum), intent(in) :: x
real(kind=default) :: absx
absx = sqrt (x%t*x%t + dot_product (x%x, x%x))
end function abs_momentum
pure function abs_vector (x) result (absx)
type(vector), intent(in) :: x
real(kind=default) :: absx
absx = sqrt (conjg(x%t)*x%t + dot_product (x%x, x%x))
end function abs_vector
pure function abs_tensor2odd (x) result (absx)
type(tensor2odd), intent(in) :: x
real(kind=default) :: absx
absx = sqrt (dot_product (x%e, x%e) + dot_product (x%b, x%b))
end function abs_tensor2odd
@
\subsection{Conjugation}
<<Declaration of operations for vectors>>=
interface conjg
module procedure conjg_momentum, conjg_vector, conjg_tensor2odd
end interface
private :: conjg_momentum, conjg_vector, conjg_tensor2odd
@
<<Implementation of operations for vectors>>=
pure function conjg_momentum (x) result (conjg_x)
type(momentum), intent(in) :: x
type(momentum) :: conjg_x
conjg_x = x
end function conjg_momentum
pure function conjg_vector (x) result (conjg_x)
type(vector), intent(in) :: x
type(vector) :: conjg_x
conjg_x%t = conjg (x%t)
conjg_x%x = conjg (x%x)
end function conjg_vector
pure function conjg_tensor2odd (t2) result (conjg_t2)
type(tensor2odd), intent(in) :: t2
type(tensor2odd) :: conjg_t2
conjg_t2%e = conjg (t2%e)
conjg_t2%b = conjg (t2%b)
end function conjg_tensor2odd
@
\subsection{$\epsilon$-Tensors}
\begin{equation}
\epsilon_{0123} = 1 = - \epsilon^{0123}
\end{equation}
in particular
\begin{equation}
\epsilon(p_1,p_2,p_3,p_4)
= \epsilon_{\mu_1\mu_2\mu_3\mu_4}
p_1^{\mu_1}p_2^{\mu_2}p_3^{\mu_3}p_4^{\mu_4}
= p_1^0 p_2^1 p_3^2 p_4^3 \pm \ldots
\end{equation}
<<Declaration of operations for vectors>>=
interface pseudo_scalar
module procedure pseudo_scalar_momentum, pseudo_scalar_vector, &
pseudo_scalar_vec_mom
end interface
public :: pseudo_scalar
private :: pseudo_scalar_momentum, pseudo_scalar_vector
@
<<Implementation of operations for vectors>>=
pure function pseudo_scalar_momentum (p1, p2, p3, p4) result (eps1234)
type(momentum), intent(in) :: p1, p2, p3, p4
real(kind=default) :: eps1234
eps1234 = &
p1%t * p2%x(1) * (p3%x(2) * p4%x(3) - p3%x(3) * p4%x(2)) &
+ p1%t * p2%x(2) * (p3%x(3) * p4%x(1) - p3%x(1) * p4%x(3)) &
+ p1%t * p2%x(3) * (p3%x(1) * p4%x(2) - p3%x(2) * p4%x(1)) &
- p1%x(1) * p2%x(2) * (p3%x(3) * p4%t - p3%t * p4%x(3)) &
- p1%x(1) * p2%x(3) * (p3%t * p4%x(2) - p3%x(2) * p4%t ) &
- p1%x(1) * p2%t * (p3%x(2) * p4%x(3) - p3%x(3) * p4%x(2)) &
+ p1%x(2) * p2%x(3) * (p3%t * p4%x(1) - p3%x(1) * p4%t ) &
+ p1%x(2) * p2%t * (p3%x(1) * p4%x(3) - p3%x(3) * p4%x(1)) &
+ p1%x(2) * p2%x(1) * (p3%x(3) * p4%t - p3%t * p4%x(3)) &
- p1%x(3) * p2%t * (p3%x(1) * p4%x(2) - p3%x(2) * p4%x(1)) &
- p1%x(3) * p2%x(1) * (p3%x(2) * p4%t - p3%t * p4%x(2)) &
- p1%x(3) * p2%x(2) * (p3%t * p4%x(1) - p3%x(1) * p4%t )
end function pseudo_scalar_momentum
@
<<Implementation of operations for vectors>>=
pure function pseudo_scalar_vector (p1, p2, p3, p4) result (eps1234)
type(vector), intent(in) :: p1, p2, p3, p4
complex(kind=default) :: eps1234
eps1234 = &
p1%t * p2%x(1) * (p3%x(2) * p4%x(3) - p3%x(3) * p4%x(2)) &
+ p1%t * p2%x(2) * (p3%x(3) * p4%x(1) - p3%x(1) * p4%x(3)) &
+ p1%t * p2%x(3) * (p3%x(1) * p4%x(2) - p3%x(2) * p4%x(1)) &
- p1%x(1) * p2%x(2) * (p3%x(3) * p4%t - p3%t * p4%x(3)) &
- p1%x(1) * p2%x(3) * (p3%t * p4%x(2) - p3%x(2) * p4%t ) &
- p1%x(1) * p2%t * (p3%x(2) * p4%x(3) - p3%x(3) * p4%x(2)) &
+ p1%x(2) * p2%x(3) * (p3%t * p4%x(1) - p3%x(1) * p4%t ) &
+ p1%x(2) * p2%t * (p3%x(1) * p4%x(3) - p3%x(3) * p4%x(1)) &
+ p1%x(2) * p2%x(1) * (p3%x(3) * p4%t - p3%t * p4%x(3)) &
- p1%x(3) * p2%t * (p3%x(1) * p4%x(2) - p3%x(2) * p4%x(1)) &
- p1%x(3) * p2%x(1) * (p3%x(2) * p4%t - p3%t * p4%x(2)) &
- p1%x(3) * p2%x(2) * (p3%t * p4%x(1) - p3%x(1) * p4%t )
end function pseudo_scalar_vector
@
<<Implementation of operations for vectors>>=
pure function pseudo_scalar_vec_mom (p1, v1, p2, v2) result (eps1234)
type(momentum), intent(in) :: p1, p2
type(vector), intent(in) :: v1, v2
complex(kind=default) :: eps1234
eps1234 = &
p1%t * v1%x(1) * (p2%x(2) * v2%x(3) - p2%x(3) * v2%x(2)) &
+ p1%t * v1%x(2) * (p2%x(3) * v2%x(1) - p2%x(1) * v2%x(3)) &
+ p1%t * v1%x(3) * (p2%x(1) * v2%x(2) - p2%x(2) * v2%x(1)) &
- p1%x(1) * v1%x(2) * (p2%x(3) * v2%t - p2%t * v2%x(3)) &
- p1%x(1) * v1%x(3) * (p2%t * v2%x(2) - p2%x(2) * v2%t ) &
- p1%x(1) * v1%t * (p2%x(2) * v2%x(3) - p2%x(3) * v2%x(2)) &
+ p1%x(2) * v1%x(3) * (p2%t * v2%x(1) - p2%x(1) * v2%t ) &
+ p1%x(2) * v1%t * (p2%x(1) * v2%x(3) - p2%x(3) * v2%x(1)) &
+ p1%x(2) * v1%x(1) * (p2%x(3) * v2%t - p2%t * v2%x(3)) &
- p1%x(3) * v1%t * (p2%x(1) * v2%x(2) - p2%x(2) * v2%x(1)) &
- p1%x(3) * v1%x(1) * (p2%x(2) * v2%t - p2%t * v2%x(2)) &
- p1%x(3) * v1%x(2) * (p2%t * v2%x(1) - p2%x(1) * v2%t )
end function pseudo_scalar_vec_mom
@
\begin{equation}
\epsilon_\mu(p_1,p_2,p_3)
= \epsilon_{\mu\mu_1\mu_2\mu_3}
p_1^{\mu_1}p_2^{\mu_2}p_3^{\mu_3}
\end{equation}
i.\,e.
\begin{subequations}
\begin{align}
\epsilon_0(p_1,p_2,p_3) &= p_1^1 p_2^2 p_3^3 \pm \ldots \\
\epsilon_1(p_1,p_2,p_3) &= p_1^2 p_2^3 p_3^0 \pm \ldots \\
\epsilon_2(p_1,p_2,p_3) &= - p_1^3 p_2^0 p_3^1 \pm \ldots \\
\epsilon_3(p_1,p_2,p_3) &= p_1^0 p_2^1 p_3^2 \pm \ldots
\end{align}
\end{subequations}
<<Declaration of operations for vectors>>=
interface pseudo_vector
module procedure pseudo_vector_momentum, pseudo_vector_vector, &
pseudo_vector_vec_mom
end interface
public :: pseudo_vector
private :: pseudo_vector_momentum, pseudo_vector_vector
@
<<Implementation of operations for vectors>>=
pure function pseudo_vector_momentum (p1, p2, p3) result (eps123)
type(momentum), intent(in) :: p1, p2, p3
type(momentum) :: eps123
eps123%t = &
+ p1%x(1) * (p2%x(2) * p3%x(3) - p2%x(3) * p3%x(2)) &
+ p1%x(2) * (p2%x(3) * p3%x(1) - p2%x(1) * p3%x(3)) &
+ p1%x(3) * (p2%x(1) * p3%x(2) - p2%x(2) * p3%x(1))
eps123%x(1) = &
+ p1%x(2) * (p2%x(3) * p3%t - p2%t * p3%x(3)) &
+ p1%x(3) * (p2%t * p3%x(2) - p2%x(2) * p3%t ) &
+ p1%t * (p2%x(2) * p3%x(3) - p2%x(3) * p3%x(2))
eps123%x(2) = &
- p1%x(3) * (p2%t * p3%x(1) - p2%x(1) * p3%t ) &
- p1%t * (p2%x(1) * p3%x(3) - p2%x(3) * p3%x(1)) &
- p1%x(1) * (p2%x(3) * p3%t - p2%t * p3%x(3))
eps123%x(3) = &
+ p1%t * (p2%x(1) * p3%x(2) - p2%x(2) * p3%x(1)) &
+ p1%x(1) * (p2%x(2) * p3%t - p2%t * p3%x(2)) &
+ p1%x(2) * (p2%t * p3%x(1) - p2%x(1) * p3%t )
end function pseudo_vector_momentum
@
<<Implementation of operations for vectors>>=
pure function pseudo_vector_vector (p1, p2, p3) result (eps123)
type(vector), intent(in) :: p1, p2, p3
type(vector) :: eps123
eps123%t = &
+ p1%x(1) * (p2%x(2) * p3%x(3) - p2%x(3) * p3%x(2)) &
+ p1%x(2) * (p2%x(3) * p3%x(1) - p2%x(1) * p3%x(3)) &
+ p1%x(3) * (p2%x(1) * p3%x(2) - p2%x(2) * p3%x(1))
eps123%x(1) = &
+ p1%x(2) * (p2%x(3) * p3%t - p2%t * p3%x(3)) &
+ p1%x(3) * (p2%t * p3%x(2) - p2%x(2) * p3%t ) &
+ p1%t * (p2%x(2) * p3%x(3) - p2%x(3) * p3%x(2))
eps123%x(2) = &
- p1%x(3) * (p2%t * p3%x(1) - p2%x(1) * p3%t ) &
- p1%t * (p2%x(1) * p3%x(3) - p2%x(3) * p3%x(1)) &
- p1%x(1) * (p2%x(3) * p3%t - p2%t * p3%x(3))
eps123%x(3) = &
+ p1%t * (p2%x(1) * p3%x(2) - p2%x(2) * p3%x(1)) &
+ p1%x(1) * (p2%x(2) * p3%t - p2%t * p3%x(2)) &
+ p1%x(2) * (p2%t * p3%x(1) - p2%x(1) * p3%t )
end function pseudo_vector_vector
@
<<Implementation of operations for vectors>>=
pure function pseudo_vector_vec_mom (p1, p2, v) result (eps123)
type(momentum), intent(in) :: p1, p2
type(vector), intent(in) :: v
type(vector) :: eps123
eps123%t = &
+ p1%x(1) * (p2%x(2) * v%x(3) - p2%x(3) * v%x(2)) &
+ p1%x(2) * (p2%x(3) * v%x(1) - p2%x(1) * v%x(3)) &
+ p1%x(3) * (p2%x(1) * v%x(2) - p2%x(2) * v%x(1))
eps123%x(1) = &
+ p1%x(2) * (p2%x(3) * v%t - p2%t * v%x(3)) &
+ p1%x(3) * (p2%t * v%x(2) - p2%x(2) * v%t ) &
+ p1%t * (p2%x(2) * v%x(3) - p2%x(3) * v%x(2))
eps123%x(2) = &
- p1%x(3) * (p2%t * v%x(1) - p2%x(1) * v%t ) &
- p1%t * (p2%x(1) * v%x(3) - p2%x(3) * v%x(1)) &
- p1%x(1) * (p2%x(3) * v%t - p2%t * v%x(3))
eps123%x(3) = &
+ p1%t * (p2%x(1) * v%x(2) - p2%x(2) * v%x(1)) &
+ p1%x(1) * (p2%x(2) * v%t - p2%t * v%x(2)) &
+ p1%x(2) * (p2%t * v%x(1) - p2%x(1) * v%t )
end function pseudo_vector_vec_mom
@
\subsection{Utilities}
<<Declaration of operations for vectors>>=
@
<<Implementation of operations for vectors>>=
subroutine random_momentum (p, pabs, m)
type(momentum), intent(out) :: p
real(kind=default), intent(in) :: pabs, m
real(kind=default), dimension(2) :: r
real(kind=default) :: phi, cos_th
call random_number (r)
phi = 2*PI * r(1)
cos_th = 2 * r(2) - 1
p%t = sqrt (pabs**2 + m**2)
p%x = pabs * (/ cos_th * cos(phi), cos_th * sin(phi), sqrt (1 - cos_th**2) /)
end subroutine random_momentum
@
\section{Polarization vectors}
<<[[omega_polarizations.f90]]>>=
<<Copyleft>>
module omega_polarizations
use kinds
use constants
use omega_vectors
implicit none
private
<<Declaration of polarization vectors>>
integer, parameter, public :: omega_polarizations_2010_01_A = 0
contains
<<Implementation of polarization vectors>>
end module omega_polarizations
@
Here we use a phase convention for the polarization vectors compatible
with the angular momentum coupling to spin 3/2 and spin 2.
\begin{subequations}
\begin{align}
\epsilon^\mu_1(k) &=
\frac{1}{|\vec k|\sqrt{k_x^2+k_y^2}}
\left(0; k_z k_x, k_y k_z, - k_x^2 - k_y^2\right) \\
\epsilon^\mu_2(k) &=
\frac{1}{\sqrt{k_x^2+k_y^2}}
\left(0; -k_y, k_x, 0\right) \\
\epsilon^\mu_3(k) &=
\frac{k_0}{m|\vec k|} \left({\vec k}^2/k_0; k_x, k_y, k_z\right)
\end{align}
\end{subequations}
and
\begin{subequations}
\begin{align}
\epsilon^\mu_\pm(k) &=
\frac{1}{\sqrt{2}} (\epsilon^\mu_1(k) \pm \ii\epsilon^\mu_2(k) ) \\
\epsilon^\mu_0(k) &= \epsilon^\mu_3(k)
\end{align}
\end{subequations}
i.\,e.
\begin{subequations}
\begin{align}
\epsilon^\mu_+(k) &=
\frac{1}{\sqrt{2}\sqrt{k_x^2+k_y^2}}
\left(0; \frac{k_zk_x}{|\vec k|} - \ii k_y,
\frac{k_yk_z}{|\vec k|} + \ii k_x,
- \frac{k_x^2+k_y^2}{|\vec k|}\right) \\
\epsilon^\mu_-(k) &=
\frac{1}{\sqrt{2}\sqrt{k_x^2+k_y^2}}
\left(0; \frac{k_zk_x}{|\vec k|} + \ii k_y,
\frac{k_yk_z}{|\vec k|} - \ii k_x,
-\frac{k_x^2+k_y^2}{|\vec k|}\right) \\
\epsilon^\mu_0(k) &=
\frac{k_0}{m|\vec k|} \left({\vec k}^2/k_0; k_x, k_y, k_z\right)
\end{align}
\end{subequations}
Determining the mass from the momenta is a numerically haphazardous for
light particles. Therefore, we accept some redundancy and pass the
mass explicitely.
<<Declaration of polarization vectors>>=
public :: eps
@
<<Implementation of polarization vectors>>=
pure function eps (m, k, s) result (e)
type(vector) :: e
real(kind=default), intent(in) :: m
type(momentum), intent(in) :: k
integer, intent(in) :: s
real(kind=default) :: kt, kabs, kabs2, sqrt2
sqrt2 = sqrt (2.0_default)
kabs2 = dot_product (k%x, k%x)
e%t = 0
e%x = 0
if (kabs2 > 0) then
kabs = sqrt (kabs2)
select case (s)
case (1)
kt = sqrt (k%x(1)**2 + k%x(2)**2)
if (abs(kt) <= epsilon(kt) * kabs) then
if (k%x(3) > 0) then
e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2
e%x(2) = cmplx ( 0, 1, kind=default) / sqrt2
else
e%x(1) = cmplx ( - 1, 0, kind=default) / sqrt2
e%x(2) = cmplx ( 0, 1, kind=default) / sqrt2
end if
else
e%x(1) = cmplx ( k%x(3)*k%x(1)/kabs, &
- k%x(2), kind=default) / kt / sqrt2
e%x(2) = cmplx ( k%x(2)*k%x(3)/kabs, &
k%x(1), kind=default) / kt / sqrt2
e%x(3) = - kt / kabs / sqrt2
end if
case (-1)
kt = sqrt (k%x(1)**2 + k%x(2)**2)
if (abs(kt) <= epsilon(kt) * kabs) then
if (k%x(3) > 0) then
e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2
e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2
else
e%x(1) = cmplx ( -1, 0, kind=default) / sqrt2
e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2
end if
else
e%x(1) = cmplx ( k%x(3)*k%x(1)/kabs, &
k%x(2), kind=default) / kt / sqrt2
e%x(2) = cmplx ( k%x(2)*k%x(3)/kabs, &
- k%x(1), kind=default) / kt / sqrt2
e%x(3) = - kt / kabs / sqrt2
end if
case (0)
if (m > 0) then
e%t = kabs / m
e%x = k%t / (m*kabs) * k%x
end if
case (3)
e = (0,1) * k
case (4)
if (m > 0) then
e = (1 / m) * k
else
e = (1 / k%t) * k
end if
end select
else !!! for particles in their rest frame defined to be
!!! polarized along the 3-direction
select case (s)
case (1)
e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2
e%x(2) = cmplx ( 0, 1, kind=default) / sqrt2
case (-1)
e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2
e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2
case (0)
if (m > 0) then
e%x(3) = 1
end if
case (4)
if (m > 0) then
e = (1 / m) * k
else
e = (1 / k%t) * k
end if
end select
end if
end function eps
@
\section{Polarization vectors revisited}
<<[[omega_polarizations_madgraph.f90]]>>=
<<Copyleft>>
module omega_polarizations_madgraph
use kinds
use constants
use omega_vectors
implicit none
private
<<Declaration of polarization vectors for madgraph>>
integer, parameter, public :: omega_pols_madgraph_2010_01_A = 0
contains
<<Implementation of polarization vectors for madgraph>>
end module omega_polarizations_madgraph
@
This set of polarization vectors is compatible with HELAS~\cite{HELAS}:
\begin{subequations}
\begin{align}
\epsilon^\mu_1(k) &=
\frac{1}{|\vec k|\sqrt{k_x^2+k_y^2}}
\left(0; k_z k_x, k_y k_z, - k_x^2 - k_y^2\right) \\
\epsilon^\mu_2(k) &=
\frac{1}{\sqrt{k_x^2+k_y^2}}
\left(0; -k_y, k_x, 0\right) \\
\epsilon^\mu_3(k) &=
\frac{k_0}{m|\vec k|} \left({\vec k}^2/k_0; k_x, k_y, k_z\right)
\end{align}
\end{subequations}
and
\begin{subequations}
\begin{align}
\epsilon^\mu_\pm(k) &=
\frac{1}{\sqrt{2}} (\mp \epsilon^\mu_1(k) - \ii\epsilon^\mu_2(k) ) \\
\epsilon^\mu_0(k) &= \epsilon^\mu_3(k)
\end{align}
\end{subequations}
i.\,e.
\begin{subequations}
\begin{align}
\epsilon^\mu_+(k) &=
\frac{1}{\sqrt{2}\sqrt{k_x^2+k_y^2}}
\left(0; -\frac{k_zk_x}{|\vec k|} + \ii k_y,
-\frac{k_yk_z}{|\vec k|} - \ii k_x,
\frac{k_x^2+k_y^2}{|\vec k|}\right) \\
\epsilon^\mu_-(k) &=
\frac{1}{\sqrt{2}\sqrt{k_x^2+k_y^2}}
\left(0; \frac{k_zk_x}{|\vec k|} + \ii k_y,
\frac{k_yk_z}{|\vec k|} - \ii k_x,
-\frac{k_x^2+k_y^2}{|\vec k|}\right) \\
\epsilon^\mu_0(k) &=
\frac{k_0}{m|\vec k|} \left({\vec k}^2/k_0; k_x, k_y, k_z\right)
\end{align}
\end{subequations}
Fortunately, for comparing with squared matrix generated by Madgraph
we can also use the modified version, since the difference is only a
phase and does \emph{not} mix helicity states.
@ Determining the mass from the momenta is a numerically haphazardous for
light particles. Therefore, we accept some redundancy and pass the
mass explicitely.
<<Declaration of polarization vectors for madgraph>>=
public :: eps
@
<<Implementation of polarization vectors for madgraph>>=
pure function eps (m, k, s) result (e)
type(vector) :: e
real(kind=default), intent(in) :: m
type(momentum), intent(in) :: k
integer, intent(in) :: s
real(kind=default) :: kt, kabs, kabs2, sqrt2
sqrt2 = sqrt (2.0_default)
kabs2 = dot_product (k%x, k%x)
e%t = 0
e%x = 0
if (kabs2 > 0) then
kabs = sqrt (kabs2)
select case (s)
case (1)
kt = sqrt (k%x(1)**2 + k%x(2)**2)
if (abs(kt) <= epsilon(kt) * kabs) then
if (k%x(3) > 0) then
e%x(1) = cmplx ( - 1, 0, kind=default) / sqrt2
e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2
else
e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2
e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2
end if
else
e%x(1) = cmplx ( - k%x(3)*k%x(1)/kabs, &
k%x(2), kind=default) / kt / sqrt2
e%x(2) = cmplx ( - k%x(2)*k%x(3)/kabs, &
- k%x(1), kind=default) / kt / sqrt2
e%x(3) = kt / kabs / sqrt2
end if
case (-1)
kt = sqrt (k%x(1)**2 + k%x(2)**2)
if (abs(kt) <= epsilon(kt) * kabs) then
if (k%x(3) > 0) then
e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2
e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2
else
e%x(1) = cmplx ( -1, 0, kind=default) / sqrt2
e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2
end if
else
e%x(1) = cmplx ( k%x(3)*k%x(1)/kabs, &
k%x(2), kind=default) / kt / sqrt2
e%x(2) = cmplx ( k%x(2)*k%x(3)/kabs, &
- k%x(1), kind=default) / kt / sqrt2
e%x(3) = - kt / kabs / sqrt2
end if
case (0)
if (m > 0) then
e%t = kabs / m
e%x = k%t / (m*kabs) * k%x
end if
case (3)
e = (0,1) * k
case (4)
if (m > 0) then
e = (1 / m) * k
else
e = (1 / k%t) * k
end if
end select
else !!! for particles in their rest frame defined to be
!!! polarized along the 3-direction
select case (s)
case (1)
e%x(1) = cmplx ( - 1, 0, kind=default) / sqrt2
e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2
case (-1)
e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2
e%x(2) = cmplx ( 0, - 1, kind=default) / sqrt2
case (0)
if (m > 0) then
e%x(3) = 1
end if
case (4)
if (m > 0) then
e = (1 / m) * k
else
e = (1 / k%t) * k
end if
end select
end if
end function eps
@
\section{Symmetric Tensors}
Spin-2 polarization tensors are symmetric, transversal and traceless
\begin{subequations}
\begin{align}
\epsilon^{\mu\nu}_{m}(k) &= \epsilon^{\nu\mu}_{m}(k) \\
k_\mu \epsilon^{\mu\nu}_{m}(k) &= k_\nu \epsilon^{\mu\nu}_{m}(k) = 0 \\
\epsilon^{\mu}_{m,\mu}(k) &= 0
\end{align}
\end{subequations}
with $m=1,2,3,4,5$. Our current representation is redundant and does
\emph{not} enforce symmetry or tracelessness.
<<[[omega_tensors.f90]]>>=
<<Copyleft>>
module omega_tensors
use kinds
use constants
use omega_vectors
implicit none
private
public :: operator (*), operator (+), operator (-), &
operator (.tprod.)
public :: abs, conjg
<<[[intrinsic :: abs]]>>
<<[[intrinsic :: conjg]]>>
type, public :: tensor
! private (omegalib needs access, but DON'T TOUCH IT!)
complex(kind=default), dimension(0:3,0:3) :: t
end type tensor
<<Declaration of operations for tensors>>
integer, parameter, public :: omega_tensors_2010_01_A = 0
contains
<<Implementation of operations for tensors>>
end module omega_tensors
@
\subsection{Vector Space}
\subsubsection{Scalar Multliplication}
<<Declaration of operations for tensors>>=
interface operator (*)
module procedure integer_tensor, real_tensor, double_tensor, &
complex_tensor, dcomplex_tensor
end interface
private :: integer_tensor, real_tensor, double_tensor
private :: complex_tensor, dcomplex_tensor
@
<<Implementation of operations for tensors>>=
pure function integer_tensor (x, y) result (xy)
integer, intent(in) :: x
type(tensor), intent(in) :: y
type(tensor) :: xy
xy%t = x * y%t
end function integer_tensor
pure function real_tensor (x, y) result (xy)
real(kind=single), intent(in) :: x
type(tensor), intent(in) :: y
type(tensor) :: xy
xy%t = x * y%t
end function real_tensor
pure function double_tensor (x, y) result (xy)
real(kind=default), intent(in) :: x
type(tensor), intent(in) :: y
type(tensor) :: xy
xy%t = x * y%t
end function double_tensor
pure function complex_tensor (x, y) result (xy)
complex(kind=single), intent(in) :: x
type(tensor), intent(in) :: y
type(tensor) :: xy
xy%t = x * y%t
end function complex_tensor
pure function dcomplex_tensor (x, y) result (xy)
complex(kind=default), intent(in) :: x
type(tensor), intent(in) :: y
type(tensor) :: xy
xy%t = x * y%t
end function dcomplex_tensor
@
\subsubsection{Addition and Subtraction}
<<Declaration of operations for tensors>>=
interface operator (+)
module procedure plus_tensor
end interface
private :: plus_tensor
interface operator (-)
module procedure neg_tensor
end interface
private :: neg_tensor
@
<<Implementation of operations for tensors>>=
pure function plus_tensor (t1) result (t2)
type(tensor), intent(in) :: t1
type(tensor) :: t2
t2 = t1
end function plus_tensor
pure function neg_tensor (t1) result (t2)
type(tensor), intent(in) :: t1
type(tensor) :: t2
t2%t = - t1%t
end function neg_tensor
@
<<Declaration of operations for tensors>>=
interface operator (+)
module procedure add_tensor
end interface
private :: add_tensor
interface operator (-)
module procedure sub_tensor
end interface
private :: sub_tensor
@
<<Implementation of operations for tensors>>=
pure function add_tensor (x, y) result (xy)
type(tensor), intent(in) :: x, y
type(tensor) :: xy
xy%t = x%t + y%t
end function add_tensor
pure function sub_tensor (x, y) result (xy)
type(tensor), intent(in) :: x, y
type(tensor) :: xy
xy%t = x%t - y%t
end function sub_tensor
@
<<Declaration of operations for tensors>>=
interface operator (.tprod.)
module procedure out_prod_vv, out_prod_vm, &
out_prod_mv, out_prod_mm
end interface
private :: out_prod_vv, out_prod_vm, &
out_prod_mv, out_prod_mm
@
<<Implementation of operations for tensors>>=
pure function out_prod_vv (v, w) result (t)
type(tensor) :: t
type(vector), intent(in) :: v, w
integer :: i, j
t%t(0,0) = v%t * w%t
t%t(0,1:3) = v%t * w%x
t%t(1:3,0) = v%x * w%t
do i = 1, 3
do j = 1, 3
t%t(i,j) = v%x(i) * w%x(j)
end do
end do
end function out_prod_vv
@
<<Implementation of operations for tensors>>=
pure function out_prod_vm (v, m) result (t)
type(tensor) :: t
type(vector), intent(in) :: v
type(momentum), intent(in) :: m
integer :: i, j
t%t(0,0) = v%t * m%t
t%t(0,1:3) = v%t * m%x
t%t(1:3,0) = v%x * m%t
do i = 1, 3
do j = 1, 3
t%t(i,j) = v%x(i) * m%x(j)
end do
end do
end function out_prod_vm
@
<<Implementation of operations for tensors>>=
pure function out_prod_mv (m, v) result (t)
type(tensor) :: t
type(vector), intent(in) :: v
type(momentum), intent(in) :: m
integer :: i, j
t%t(0,0) = m%t * v%t
t%t(0,1:3) = m%t * v%x
t%t(1:3,0) = m%x * v%t
do i = 1, 3
do j = 1, 3
t%t(i,j) = m%x(i) * v%x(j)
end do
end do
end function out_prod_mv
@
<<Implementation of operations for tensors>>=
pure function out_prod_mm (m, n) result (t)
type(tensor) :: t
type(momentum), intent(in) :: m, n
integer :: i, j
t%t(0,0) = m%t * n%t
t%t(0,1:3) = m%t * n%x
t%t(1:3,0) = m%x * n%t
do i = 1, 3
do j = 1, 3
t%t(i,j) = m%x(i) * n%x(j)
end do
end do
end function out_prod_mm
@
<<Declaration of operations for tensors>>=
interface abs
module procedure abs_tensor
end interface
private :: abs_tensor
@
<<Implementation of operations for tensors>>=
pure function abs_tensor (t) result (abs_t)
type(tensor), intent(in) :: t
real(kind=default) :: abs_t
abs_t = sqrt (sum ((abs (t%t))**2))
end function abs_tensor
@
<<Declaration of operations for tensors>>=
interface conjg
module procedure conjg_tensor
end interface
private :: conjg_tensor
@
<<Implementation of operations for tensors>>=
pure function conjg_tensor (t) result (conjg_t)
type(tensor), intent(in) :: t
type(tensor) :: conjg_t
conjg_t%t = conjg (t%t)
end function conjg_tensor
@
<<Declaration of operations for tensors>>=
interface operator (*)
module procedure tensor_tensor, vector_tensor, tensor_vector, &
momentum_tensor, tensor_momentum
end interface
private :: tensor_tensor, vector_tensor, tensor_vector, &
momentum_tensor, tensor_momentum
@
<<Implementation of operations for tensors>>=
pure function tensor_tensor (t1, t2) result (t1t2)
type(tensor), intent(in) :: t1
type(tensor), intent(in) :: t2
complex(kind=default) :: t1t2
integer :: i1, i2
t1t2 = t1%t(0,0)*t2%t(0,0) &
- dot_product (conjg (t1%t(0,1:)), t2%t(0,1:)) &
- dot_product (conjg (t1%t(1:,0)), t2%t(1:,0))
do i1 = 1, 3
do i2 = 1, 3
t1t2 = t1t2 + t1%t(i1,i2)*t2%t(i1,i2)
end do
end do
end function tensor_tensor
@
<<Implementation of operations for tensors>>=
pure function tensor_vector (t, v) result (tv)
type(tensor), intent(in) :: t
type(vector), intent(in) :: v
type(vector) :: tv
tv%t = t%t(0,0) * v%t - dot_product (conjg (t%t(0,1:)), v%x)
tv%x(1) = t%t(0,1) * v%t - dot_product (conjg (t%t(1,1:)), v%x)
tv%x(2) = t%t(0,2) * v%t - dot_product (conjg (t%t(2,1:)), v%x)
tv%x(3) = t%t(0,3) * v%t - dot_product (conjg (t%t(3,1:)), v%x)
end function tensor_vector
@
<<Implementation of operations for tensors>>=
pure function vector_tensor (v, t) result (vt)
type(vector), intent(in) :: v
type(tensor), intent(in) :: t
type(vector) :: vt
vt%t = v%t * t%t(0,0) - dot_product (conjg (v%x), t%t(1:,0))
vt%x(1) = v%t * t%t(0,1) - dot_product (conjg (v%x), t%t(1:,1))
vt%x(2) = v%t * t%t(0,2) - dot_product (conjg (v%x), t%t(1:,2))
vt%x(3) = v%t * t%t(0,3) - dot_product (conjg (v%x), t%t(1:,3))
end function vector_tensor
@
<<Implementation of operations for tensors>>=
pure function tensor_momentum (t, p) result (tp)
type(tensor), intent(in) :: t
type(momentum), intent(in) :: p
type(vector) :: tp
tp%t = t%t(0,0) * p%t - dot_product (conjg (t%t(0,1:)), p%x)
tp%x(1) = t%t(0,1) * p%t - dot_product (conjg (t%t(1,1:)), p%x)
tp%x(2) = t%t(0,2) * p%t - dot_product (conjg (t%t(2,1:)), p%x)
tp%x(3) = t%t(0,3) * p%t - dot_product (conjg (t%t(3,1:)), p%x)
end function tensor_momentum
@
<<Implementation of operations for tensors>>=
pure function momentum_tensor (p, t) result (pt)
type(momentum), intent(in) :: p
type(tensor), intent(in) :: t
type(vector) :: pt
pt%t = p%t * t%t(0,0) - dot_product (p%x, t%t(1:,0))
pt%x(1) = p%t * t%t(0,1) - dot_product (p%x, t%t(1:,1))
pt%x(2) = p%t * t%t(0,2) - dot_product (p%x, t%t(1:,2))
pt%x(3) = p%t * t%t(0,3) - dot_product (p%x, t%t(1:,3))
end function momentum_tensor
@
\section{Symmetric Polarization Tensors}
\begin{subequations}
\begin{align}
\epsilon^{\mu\nu}_{+2}(k) &= \epsilon^{\mu}_{+}(k)\epsilon^{\nu}_{+}(k) \\
\epsilon^{\mu\nu}_{+1}(k) &= \frac{1}{\sqrt{2}}
\left( \epsilon^{\mu}_{+}(k)\epsilon^{\nu}_{0}(k)
+ \epsilon^{\mu}_{0}(k)\epsilon^{\nu}_{+}(k) \right) \\
\epsilon^{\mu\nu}_{0}(k) &= \frac{1}{\sqrt{6}}
\left( \epsilon^{\mu}_{+}(k)\epsilon^{\nu}_{-}(k)
+ \epsilon^{\mu}_{-}(k)\epsilon^{\nu}_{+}(k)
- 2 \epsilon^{\mu}_{0}(k)\epsilon^{\nu}_{0}(k) \right) \\
\epsilon^{\mu\nu}_{-1}(k) &= \frac{1}{\sqrt{2}}
\left( \epsilon^{\mu}_{-}(k)\epsilon^{\nu}_{0}(k)
+ \epsilon^{\mu}_{0}(k)\epsilon^{\nu}_{-}(k) \right) \\
\epsilon^{\mu\nu}_{-2}(k) &= \epsilon^{\mu}_{-}(k)\epsilon^{\nu}_{-}(k)
\end{align}
\end{subequations}
Note that~$\epsilon^{\mu}_{\pm2,\mu}(k) =
\epsilon^{\mu}_{\pm}(k)\epsilon_{\pm,\mu}(k) \propto
\epsilon^{\mu}_{\pm}(k)\epsilon_{\mp,\mu}^{*}(k) = 0$ and that the sign in
$\epsilon^{\mu\nu}_{0}(k)$ insures its tracelessness\footnote{
On the other hand, with the shift operator
$L_{-}\ket{+}=\ee^{\ii\phi}\ket{0}$ and
$L_{-}\ket{0}=\ee^{\ii\chi}\ket{-}$, we find
\begin{equation*}
L_{-}^{2}\ket{++} =
2\ee^{2\ii\phi}\ket{00} + \ee^{\ii(\phi+\chi)}(\ket{+-}+\ket{-+})
\end{equation*}
i.\,e.~$\chi-\phi=\pi$, if we want to identify
$\epsilon^{\mu}_{-,0,+}$ with $\ket{-,0,+}$.}.
<<[[omega_tensor_polarizations.f90]]>>=
<<Copyleft>>
module omega_tensor_polarizations
use kinds
use constants
use omega_vectors
use omega_tensors
use omega_polarizations
implicit none
private
<<Declaration of polarization tensors>>
integer, parameter, public :: omega_tensor_pols_2010_01_A = 0
contains
<<Implementation of polarization tensors>>
end module omega_tensor_polarizations
@
<<Declaration of polarization tensors>>=
public :: eps2
@
<<Implementation of polarization tensors>>=
pure function eps2 (m, k, s) result (t)
type(tensor) :: t
real(kind=default), intent(in) :: m
type(momentum), intent(in) :: k
integer, intent(in) :: s
type(vector) :: ep, em, e0
t%t = 0
select case (s)
case (2)
ep = eps (m, k, 1)
t = ep.tprod.ep
case (1)
ep = eps (m, k, 1)
e0 = eps (m, k, 0)
t = (1 / sqrt (2.0_default)) &
* ((ep.tprod.e0) + (e0.tprod.ep))
case (0)
ep = eps (m, k, 1)
e0 = eps (m, k, 0)
em = eps (m, k, -1)
t = (1 / sqrt (6.0_default)) &
* ((ep.tprod.em) + (em.tprod.ep) - 2*(e0.tprod.e0))
case (-1)
e0 = eps (m, k, 0)
em = eps (m, k, -1)
t = (1 / sqrt (2.0_default)) &
* ((em.tprod.e0) + (e0.tprod.em))
case (-2)
em = eps (m, k, -1)
t = em.tprod.em
end select
end function eps2
@ \section{Couplings}
<<[[omega_couplings.f90]]>>=
<<Copyleft>>
module omega_couplings
use kinds
use constants
use omega_vectors
use omega_tensors
implicit none
private
<<Declaration of couplings>>
<<Declaration of propagators>>
integer, parameter, public :: omega_couplings_2010_01_A = 0
contains
<<Implementation of couplings>>
<<Implementation of propagators>>
end module omega_couplings
@
<<Declaration of propagators>>=
public :: wd_tl
@
<<Declaration of propagators>>=
public :: gauss
@
\begin{equation}
\Theta(p^2)\Gamma
\end{equation}
<<Implementation of propagators>>=
pure function wd_tl (p, w) result (width)
real(kind=default) :: width
type(momentum), intent(in) :: p
real(kind=default), intent(in) :: w
if (p*p > 0) then
width = w
else
width = 0
end if
end function wd_tl
@
<<Implementation of propagators>>=
pure function gauss (x, mu, w) result (gg)
real(kind=default) :: gg
real(kind=default), intent(in) :: x, mu, w
if (w > 0) then
gg = exp(-(x - mu**2)**2/4.0_default/mu**2/w**2) * &
sqrt(sqrt(PI/2)) / w / mu
else
gg = 1.0_default
end if
end function gauss
@
<<Declaration of propagators>>=
public :: pr_phi, pr_unitarity, pr_feynman, pr_gauge, pr_rxi
public :: pj_phi, pj_unitarity
public :: pg_phi, pg_unitarity
@
\begin{equation}
\frac{\ii}{p^2-m^2+\ii m\Gamma}\phi
\end{equation}
<<Implementation of propagators>>=
pure function pr_phi (p, m, w, phi) result (pphi)
complex(kind=default) :: pphi
type(momentum), intent(in) :: p
real(kind=default), intent(in) :: m, w
complex(kind=default), intent(in) :: phi
pphi = (1 / cmplx (p*p - m**2, m*w, kind=default)) * phi
end function pr_phi
@
\begin{equation}
\sqrt{\frac{\pi}{M\Gamma}}
\phi
\end{equation}
<<Implementation of propagators>>=
pure function pj_phi (m, w, phi) result (pphi)
complex(kind=default) :: pphi
real(kind=default), intent(in) :: m, w
complex(kind=default), intent(in) :: phi
pphi = (0, -1) * sqrt (PI / m / w) * phi
end function pj_phi
@
<<Implementation of propagators>>=
pure function pg_phi (p, m, w, phi) result (pphi)
complex(kind=default) :: pphi
type(momentum), intent(in) :: p
real(kind=default), intent(in) :: m, w
complex(kind=default), intent(in) :: phi
pphi = ((0, 1) * gauss (p*p, m, w)) * phi
end function pg_phi
@
\begin{equation}
\frac{\ii}{p^2-m^2+\ii m\Gamma}
\left( -g_{\mu\nu} + \frac{p_\mu p_\nu}{m^2} \right) \epsilon^\nu(p)
\end{equation}
NB: the explicit cast to [[vector]] is required here, because a specific
[[complex_momentum]] procedure for [[operator (*)]] would introduce
ambiguities.
NB: we used to use the constructor [[vector (p%t, p%x)]] instead of
the temporary variable, but the Intel Fortran Compiler choked on it.
<<Implementation of propagators>>=
pure function pr_unitarity (p, m, w, e) result (pe)
type(vector) :: pe
type(momentum), intent(in) :: p
real(kind=default), intent(in) :: m, w
type(vector), intent(in) :: e
type(vector) :: pv
pv = p
pe = - (1 / cmplx (p*p - m**2, m*w, kind=default)) &
* (e - (p*e / m**2) * pv)
end function pr_unitarity
@
\begin{equation}
\sqrt{\frac{\pi}{M\Gamma}}
\left( -g_{\mu\nu} + \frac{p_\mu p_\nu}{m^2} \right) \epsilon^\nu(p)
\end{equation}
<<Implementation of propagators>>=
pure function pj_unitarity (p, m, w, e) result (pe)
type(vector) :: pe
type(momentum), intent(in) :: p
real(kind=default), intent(in) :: m, w
type(vector), intent(in) :: e
type(vector) :: pv
pv = p
pe = (0, 1) * sqrt (PI / m / w) * (e - (p*e / m**2) * pv)
end function pj_unitarity
@
<<Implementation of propagators>>=
pure function pg_unitarity (p, m, w, e) result (pe)
type(vector) :: pe
type(momentum), intent(in) :: p
real(kind=default), intent(in) :: m, w
type(vector), intent(in) :: e
type(vector) :: pv
pv = p
pe = - gauss (p*p, m, w) &
* (e - (p*e / m**2) * pv)
end function pg_unitarity
@
\begin{equation}
\frac{-i}{p^2} \epsilon^\nu(p)
\end{equation}
<<Implementation of propagators>>=
pure function pr_feynman (p, e) result (pe)
type(vector) :: pe
type(momentum), intent(in) :: p
type(vector), intent(in) :: e
pe = - (1 / (p*p)) * e
end function pr_feynman
@
\begin{equation}
\frac{\ii}{p^2}
\left( -g_{\mu\nu} + (1-\xi)\frac{p_\mu p_\nu}{p^2} \right)
\epsilon^\nu(p)
\end{equation}
<<Implementation of propagators>>=
pure function pr_gauge (p, xi, e) result (pe)
type(vector) :: pe
type(momentum), intent(in) :: p
real(kind=default), intent(in) :: xi
type(vector), intent(in) :: e
real(kind=default) :: p2
type(vector) :: pv
p2 = p*p
pv = p
pe = - (1 / p2) * (e - ((1 - xi) * (p*e) / p2) * pv)
end function pr_gauge
@
\begin{equation}
\frac{\ii}{p^2-m^2+\ii m\Gamma}
\left( -g_{\mu\nu} + (1-\xi)\frac{p_\mu p_\nu}{p^2-\xi m^2} \right)
\epsilon^\nu(p)
\end{equation}
<<Implementation of propagators>>=
pure function pr_rxi (p, m, w, xi, e) result (pe)
type(vector) :: pe
type(momentum), intent(in) :: p
real(kind=default), intent(in) :: m, w, xi
type(vector), intent(in) :: e
real(kind=default) :: p2
type(vector) :: pv
p2 = p*p
pv = p
pe = - (1 / cmplx (p2 - m**2, m*w, kind=default)) &
* (e - ((1 - xi) * (p*e) / (p2 - xi * m**2)) * pv)
end function pr_rxi
@
<<Declaration of propagators>>=
public :: pr_tensor
@
\begin{subequations}
\begin{equation}
\frac{\ii P^{\mu\nu,\rho\sigma}(p,m)}{p^2-m^2+\ii m\Gamma} T_{\rho\sigma}
\end{equation}
with
\begin{multline}
P^{\mu\nu,\rho\sigma}(p,m)
= \frac{1}{2} \left(g^{\mu\rho}-\frac{p^{\mu}p^{\nu}}{m^2}\right)
\left(g^{\nu\sigma}-\frac{p^{\nu}p^{\sigma}}{m^2}\right)
+ \frac{1}{2} \left(g^{\mu\sigma}-\frac{p^{\mu}p^{\sigma}}{m^2}\right)
\left(g^{\nu\rho}-\frac{p^{\nu}p^{\rho}}{m^2}\right) \\
- \frac{1}{3} \left(g^{\mu\nu}-\frac{p^{\mu}p^{\nu}}{m^2}\right)
\left(g^{\rho\sigma}-\frac{p^{\rho}p^{\sigma}}{m^2}\right)
\end{multline}
\end{subequations}
Be careful with raising and lowering of indices:
\begin{subequations}
\begin{align}
g^{\mu\nu}-\frac{k^{\mu}k^{\nu}}{m^2}
&= \begin{pmatrix}
1 - k^0k^0 / m^2 & - k^0 \vec k / m^2 \\
- \vec k k^0 / m^2 & - \mathbf{1} - \vec k \otimes \vec k / m^2
\end{pmatrix} \\
g^{\mu}_{\hphantom{\mu}\nu}-\frac{k^{\mu}k_{\nu}}{m^2}
&= \begin{pmatrix}
1 - k^0k^0 / m^2 & k^0 \vec k / m^2 \\
- \vec k k^0 / m^2 & \mathbf{1} + \vec k \otimes \vec k / m^2
\end{pmatrix}
\end{align}
\end{subequations}
<<Implementation of propagators>>=
pure function pr_tensor (p, m, w, t) result (pt)
type(tensor) :: pt
type(momentum), intent(in) :: p
real(kind=default), intent(in) :: m, w
type(tensor), intent(in) :: t
complex(kind=default) :: p_dd_t
real(kind=default), dimension(0:3,0:3) :: p_uu, p_ud, p_du, p_dd
integer :: i, j
p_uu(0,0) = 1 - p%t * p%t / m**2
p_uu(0,1:3) = - p%t * p%x / m**2
p_uu(1:3,0) = p_uu(0,1:3)
do i = 1, 3
do j = 1, 3
p_uu(i,j) = - p%x(i) * p%x(j) / m**2
end do
end do
do i = 1, 3
p_uu(i,i) = - 1 + p_uu(i,i)
end do
p_ud(:,0) = p_uu(:,0)
p_ud(:,1:3) = - p_uu(:,1:3)
p_du = transpose (p_ud)
p_dd(:,0) = p_du(:,0)
p_dd(:,1:3) = - p_du(:,1:3)
p_dd_t = 0
do i = 0, 3
do j = 0, 3
p_dd_t = p_dd_t + p_dd(i,j) * t%t(i,j)
end do
end do
pt%t = matmul (p_ud, matmul (0.5_default * (t%t + transpose (t%t)), p_du)) &
- (p_dd_t / 3.0_default) * p_uu
pt%t = pt%t / cmplx (p*p - m**2, m*w, kind=default)
end function pr_tensor
@ \subsection{Triple Gauge Couplings}
<<Declaration of couplings>>=
public :: g_gg
@ According to~(\ref{eq:fuse-gauge})
\begin{multline}
A^{a,\mu}(k_1+k_2) = - \ii g
\bigl( (k_1^{\mu}-k_2^{\mu})A^{a_1}(k_1) \cdot A^{a_2}(k_2) \\
+ (2k_2+k_1)\cdot A^{a_1}(k_1)A^{a_2,\mu}(k_2)
- A^{a_1,\mu}(k_1)A^{a_2}(k_2)\cdot(2k_1+k_2) \bigr)
\end{multline}
<<Implementation of couplings>>=
pure function g_gg (g, a1, k1, a2, k2) result (a)
complex(kind=default), intent(in) :: g
type(vector), intent(in) :: a1, a2
type(momentum), intent(in) :: k1, k2
type(vector) :: a
a = (0, -1) * g * ((k1 - k2) * (a1 * a2) &
+ ((2*k2 + k1) * a1) * a2 - a1 * ((2*k1 + k2) * a2))
end function g_gg
@ \subsection{Quadruple Gauge Couplings}
<<Declaration of couplings>>=
public :: x_gg, g_gx
@
\begin{equation}
T^{a,\mu\nu}(k_1+k_2) = g
\bigl( A^{a_1,\mu}(k_1) A^{a_2,\nu}(k_2) - A^{a_1,\nu}(k_1) A^{a_2,\mu}(k_2) \bigr)
\end{equation}
<<Implementation of couplings>>=
pure function x_gg (g, a1, a2) result (x)
complex(kind=default), intent(in) :: g
type(vector), intent(in) :: a1, a2
type(tensor2odd) :: x
x = g * (a1 .wedge. a2)
end function x_gg
@
\begin{equation}
A^{a,\mu}(k_1+k_2) = g A^{a_1}_\nu(k_1) T^{a_2,\nu\mu}(k_2)
\end{equation}
<<Implementation of couplings>>=
pure function g_gx (g, a1, x) result (a)
complex(kind=default), intent(in) :: g
type(vector), intent(in) :: a1
type(tensor2odd), intent(in) :: x
type(vector) :: a
a = g * (a1 * x)
end function g_gx
@ \subsection{Scalar Current}
<<Declaration of couplings>>=
public :: v_ss, s_vs
@
\begin{equation}
V^\mu(k_1+k_2) = g(k_1^\mu - k_2^\mu)\phi_1(k_1)\phi_2(k_2)
\end{equation}
<<Implementation of couplings>>=
pure function v_ss (g, phi1, k1, phi2, k2) result (v)
complex(kind=default), intent(in) :: g, phi1, phi2
type(momentum), intent(in) :: k1, k2
type(vector) :: v
v = (k1 - k2) * (g * phi1 * phi2)
end function v_ss
@
\begin{equation}
\phi(k_1+k_2) = g(k_1^\mu + 2k_2^\mu)V_\mu(k_1)\phi(k_2)
\end{equation}
<<Implementation of couplings>>=
pure function s_vs (g, v1, k1, phi2, k2) result (phi)
complex(kind=default), intent(in) :: g, phi2
type(vector), intent(in) :: v1
type(momentum), intent(in) :: k1, k2
complex(kind=default) :: phi
phi = g * ((k1 + 2*k2) * v1) * phi2
end function s_vs
@ \subsection{Triple Vector Couplings}
<<Declaration of couplings>>=
public :: tkv_vv, lkv_vv, tv_kvv, lv_kvv, kg_kgkg
public :: t5kv_vv, l5kv_vv, t5v_kvv, l5v_kvv, kg5_kgkg, kg_kg5kg
@
\begin{equation}
V^\mu(k_1+k_2) = \ii g(k_1-k_2)^\mu V_1^\nu(k_1)V_{2,\nu}(k_2)
\end{equation}
<<Implementation of couplings>>=
pure function tkv_vv (g, v1, k1, v2, k2) result (v)
complex(kind=default), intent(in) :: g
type(vector), intent(in) :: v1, v2
type(momentum), intent(in) :: k1, k2
type(vector) :: v
v = (k1 - k2) * ((0, 1) * g * (v1*v2))
end function tkv_vv
@
\begin{equation}
V^\mu(k_1+k_2) = \ii g \epsilon^{\mu\nu\rho\sigma}
(k_1-k_2)_{\nu} V_{1,\rho}(k_1)V_{2,\sigma}(k_2)
\end{equation}
<<Implementation of couplings>>=
pure function t5kv_vv (g, v1, k1, v2, k2) result (v)
complex(kind=default), intent(in) :: g
type(vector), intent(in) :: v1, v2
type(momentum), intent(in) :: k1, k2
type(vector) :: v
type(vector) :: k
k = k1 - k2
v = (0, 1) * g * pseudo_vector (k, v1, v2)
end function t5kv_vv
@
\begin{equation}
V^\mu(k_1+k_2) = \ii g(k_1+k_2)^\mu V_1^\nu(k_1)V_{2,\nu}(k_2)
\end{equation}
<<Implementation of couplings>>=
pure function lkv_vv (g, v1, k1, v2, k2) result (v)
complex(kind=default), intent(in) :: g
type(vector), intent(in) :: v1, v2
type(momentum), intent(in) :: k1, k2
type(vector) :: v
v = (k1 + k2) * ((0, 1) * g * (v1*v2))
end function lkv_vv
@
\begin{equation}
V^\mu(k_1+k_2) = \ii g \epsilon^{\mu\nu\rho\sigma}
(k_1+k_2)_{\nu} V_{1,\rho}(k_1)V_{2,\sigma}(k_2)
\end{equation}
<<Implementation of couplings>>=
pure function l5kv_vv (g, v1, k1, v2, k2) result (v)
complex(kind=default), intent(in) :: g
type(vector), intent(in) :: v1, v2
type(momentum), intent(in) :: k1, k2
type(vector) :: v
type(vector) :: k
k = k1 + k2
v = (0, 1) * g * pseudo_vector (k, v1, v2)
end function l5kv_vv
@
\begin{equation}
V^\mu(k_1+k_2) = \ii g (k_2-k)^\nu V_{1,\nu}(k_1)V_2^\mu(k_2)
= \ii g (2k_2+k_1)^\nu V_{1,\nu}(k_1)V_2^\mu(k_2)
\end{equation}
using $k=-k_1-k_2$
<<Implementation of couplings>>=
pure function tv_kvv (g, v1, k1, v2, k2) result (v)
complex(kind=default), intent(in) :: g
type(vector), intent(in) :: v1, v2
type(momentum), intent(in) :: k1, k2
type(vector) :: v
v = v2 * ((0, 1) * g * ((2*k2 + k1)*v1))
end function tv_kvv
@
\begin{equation}
V^\mu(k_1+k_2) = \ii g \epsilon^{\mu\nu\rho\sigma}
(2k_2+k_1)_{\nu} V_{1,\rho}(k_1)V_{2,\sigma}(k_2)
\end{equation}
<<Implementation of couplings>>=
pure function t5v_kvv (g, v1, k1, v2, k2) result (v)
complex(kind=default), intent(in) :: g
type(vector), intent(in) :: v1, v2
type(momentum), intent(in) :: k1, k2
type(vector) :: v
type(vector) :: k
k = k1 + 2*k2
v = (0, 1) * g * pseudo_vector (k, v1, v2)
end function t5v_kvv
@
\begin{equation}
V^\mu(k_1+k_2) = - \ii g k_1^\nu V_{1,\nu}(k_1)V_2^\mu(k_2)
\end{equation}
using $k=-k_1-k_2$
<<Implementation of couplings>>=
pure function lv_kvv (g, v1, k1, v2) result (v)
complex(kind=default), intent(in) :: g
type(vector), intent(in) :: v1, v2
type(momentum), intent(in) :: k1
type(vector) :: v
v = v2 * ((0, -1) * g * (k1*v1))
end function lv_kvv
@
\begin{equation}
V^\mu(k_1+k_2) = - \ii g \epsilon^{\mu\nu\rho\sigma}
k_{1,\nu} V_{1,\rho}(k_1)V_{2,\sigma}(k_2)
\end{equation}
<<Implementation of couplings>>=
pure function l5v_kvv (g, v1, k1, v2) result (v)
complex(kind=default), intent(in) :: g
type(vector), intent(in) :: v1, v2
type(momentum), intent(in) :: k1
type(vector) :: v
type(vector) :: k
k = k1
v = (0, -1) * g * pseudo_vector (k, v1, v2)
end function l5v_kvv
@
\begin{equation}
A^\mu(k_1+k_2) = \ii g k^\nu
\Bigl( F_{1,\nu}^{\hphantom{1,\nu}\rho}(k_1)F_{2,\rho\mu}(k_2)
- F_{1,\mu}^{\hphantom{1,\mu}\rho}(k_1)F_{2,\rho\nu}(k_2) \Bigr)
\end{equation}
with $k=-k_1-k_2$, i.\,e.
\begin{multline}
A^\mu(k_1+k_2) = -\ii g
\Bigl( [(kk_2)(k_1A_2) - (k_1k_2)(kA_2)] A_1^\mu \\
+ [(k_1k_2)(kA_1) - (kk_1)(k_2A_1)] A_2^\mu \\
+ [(k_2A_1)(kA_2) - (kk_2)(A_1A_2)] k_1^\mu \\
+ [(kk_1)(A_1A_2) - (kA_1)(k_1A_2)] k_2^\mu \Bigr)
\end{multline}
<<Implementation of couplings>>=
pure function kg_kgkg (g, a1, k1, a2, k2) result (a)
complex(kind=default), intent(in) :: g
type(vector), intent(in) :: a1, a2
type(momentum), intent(in) :: k1, k2
type(vector) :: a
real(kind=default) :: k1k1, k2k2, k1k2, kk1, kk2
complex(kind=default) :: a1a2, k2a1, ka1, k1a2, ka2
k1k1 = k1 * k1
k1k2 = k1 * k2
k2k2 = k2 * k2
kk1 = k1k1 + k1k2
kk2 = k1k2 + k2k2
k2a1 = k2 * a1
ka1 = k2a1 + k1 * a1
k1a2 = k1 * a2
ka2 = k1a2 + k2 * a2
a1a2 = a1 * a2
a = (0, -1) * g * ( (kk2 * k1a2 - k1k2 * ka2 ) * a1 &
+ (k1k2 * ka1 - kk1 * k2a1) * a2 &
+ (ka2 * k2a1 - kk2 * a1a2) * k1 &
+ (kk1 * a1a2 - ka1 * k1a2) * k2 )
end function kg_kgkg
@
\begin{equation}
A^\mu(k_1+k_2) = \ii g \epsilon^{\mu\nu\rho\sigma} k_{\nu}
F_{1,\rho}^{\hphantom{1,\rho}\lambda}(k_1)F_{2,\lambda\sigma}(k_2)
\end{equation}
with $k=-k_1-k_2$, i.\,e.
\begin{multline}
A^\mu(k_1+k_2) = -2\ii g \epsilon^{\mu\nu\rho\sigma} k_{\nu}
\Bigl( (k_2A_1) k_{1,\rho} A_{2,\sigma}
+ (k_1A_2) A_{1,\rho} k_{2,\sigma} \\
- (A_1A_2) k_{1,\rho} k_{2,\sigma}
- (k_1k_2) A_{1,\rho} A_{2,\sigma} \Bigr)
\end{multline}
<<Implementation of couplings>>=
pure function kg5_kgkg (g, a1, k1, a2, k2) result (a)
complex(kind=default), intent(in) :: g
type(vector), intent(in) :: a1, a2
type(momentum), intent(in) :: k1, k2
type(vector) :: a
type(vector) :: kv, k1v, k2v
kv = - k1 - k2
k1v = k1
k2v = k2
a = (0, -2) * g * ( (k2*A1) * pseudo_vector (kv, k1v, a2 ) &
+ (k1*A2) * pseudo_vector (kv, A1 , k2v) &
- (A1*A2) * pseudo_vector (kv, k1v, k2v) &
- (k1*k2) * pseudo_vector (kv, a1 , a2 ) )
end function kg5_kgkg
@
\begin{equation}
A^\mu(k_1+k_2) = \ii g k_{\nu} \Bigl(
\epsilon^{\mu\rho\lambda\sigma}
F_{1,\hphantom{\nu}\rho}^{\hphantom{1,}\nu}
- \epsilon^{\nu\rho\lambda\sigma}
F_{1,\hphantom{\mu}\rho}^{\hphantom{1,}\mu} \Bigr)
\frac{1}{2} F_{1,\lambda\sigma}
\end{equation}
with $k=-k_1-k_2$, i.\,e.
\begin{multline}
A^\mu(k_1+k_2) = -\ii g \Bigl(
\epsilon^{\mu\rho\lambda\sigma} (kk_2) A_{2,\rho}
- \epsilon^{\mu\rho\lambda\sigma} (kA_2) k_{2,\rho}
- k_2^\mu \epsilon^{\nu\rho\lambda\sigma} k_nu A_{2,\rho}
+ A_2^\mu \epsilon^{\nu\rho\lambda\sigma} k_nu k_{2,\rho}
\Bigr) k_{1,\lambda} A_{1,\sigma}
\end{multline}
\begin{dubious}
This is not the most efficienct way of doing it:
$\epsilon^{\mu\nu\rho\sigma}F_{1,\rho\sigma}$ should be cached!
\end{dubious}
<<Implementation of couplings>>=
pure function kg_kg5kg (g, a1, k1, a2, k2) result (a)
complex(kind=default), intent(in) :: g
type(vector), intent(in) :: a1, a2
type(momentum), intent(in) :: k1, k2
type(vector) :: a
type(vector) :: kv, k1v, k2v
kv = - k1 - k2
k1v = k1
k2v = k2
a = (0, -1) * g * ( (kv*k2v) * pseudo_vector (a2 , k1v, a1) &
- (kv*a2 ) * pseudo_vector (k2v, k1v, a1) &
- k2v * pseudo_scalar (kv, a2, k1v, a1) &
+ a2 * pseudo_scalar (kv, k2v, k1v, a1) )
end function kg_kg5kg
@ \section{Graviton Couplings}
<<Declaration of couplings>>=
public :: s_gravs, v_gravv, grav_ss, grav_vv
@
<<Implementation of couplings>>=
pure function s_gravs (g, m, k1, k2, t, s) result (phi)
complex(kind=default), intent(in) :: g, s
real(kind=default), intent(in) :: m
type(momentum), intent(in) :: k1, k2
type(tensor), intent(in) :: t
complex(kind=default) :: phi, t_tr
t_tr = t%t(0,0) - t%t(1,1) - t%t(2,2) - t%t(3,3)
phi = g * s * (((t*k1)*k2) + ((t*k2)*k1) &
- g * (m**2 + (k1*k2))*t_tr)/2.0_default
end function s_gravs
@
<<Implementation of couplings>>=
pure function grav_ss (g, m, k1, k2, s1, s2) result (t)
complex(kind=default), intent(in) :: g, s1, s2
real(kind=default), intent(in) :: m
type(momentum), intent(in) :: k1, k2
type(tensor) :: t_metric, t
t_metric%t = 0
t_metric%t(0,0) = 1.0_default
t_metric%t(1,1) = - 1.0_default
t_metric%t(2,2) = - 1.0_default
t_metric%t(3,3) = - 1.0_default
t = g*s1*s2/2.0_default * (-(m**2 + (k1*k2)) * t_metric &
+ (k1.tprod.k2) + (k2.tprod.k1))
end function grav_ss
@
<<Implementation of couplings>>=
pure function v_gravv (g, m, k1, k2, t, v) result (vec)
complex(kind=default), intent(in) :: g
real(kind=default), intent(in) :: m
type(momentum), intent(in) :: k1, k2
type(vector), intent(in) :: v
type(tensor), intent(in) :: t
complex(kind=default) :: t_tr
real(kind=default) :: xi
type(vector) :: vec
xi = 1.0_default
t_tr = t%t(0,0) - t%t(1,1) - t%t(2,2) - t%t(3,3)
vec = (-g)/ 2.0_default * (((k1*k2) + m**2) * &
(t*v + v*t - t_tr * v) + t_tr * (k1*v) * k2 &
- (k1*v) * ((k2*t) + (t*k2)) &
- ((k1*(t*v)) + (v*(t*k1))) * k2 &
+ ((k1*(t*k2)) + (k2*(t*k1))) * v)
!!! Unitarity gauge: xi -> Infinity
!!! + (1.0_default/xi) * (t_tr * ((k1*v)*k2) + &
!!! (k2*v)*k2 + (k2*v)*k1 - (k1*(t*v))*k1 + &
!!! (k2*v)*(k2*t) - (v*(t*k1))*k1 - (k2*v)*(t*k2)))
end function v_gravv
@
<<Implementation of couplings>>=
pure function grav_vv (g, m, k1, k2, v1, v2) result (t)
complex(kind=default), intent(in) :: g
type(momentum), intent(in) :: k1, k2
real(kind=default), intent(in) :: m
real(kind=default) :: xi
type(vector), intent (in) :: v1, v2
type(tensor) :: t_metric, t
xi = 0.00001_default
t_metric%t = 0
t_metric%t(0,0) = 1.0_default
t_metric%t(1,1) = - 1.0_default
t_metric%t(2,2) = - 1.0_default
t_metric%t(3,3) = - 1.0_default
t = (-g)/2.0_default * ( &
((k1*k2) + m**2) * ( &
(v1.tprod.v2) + (v2.tprod.v1) - (v1*v2) * t_metric) &
+ (v1*k2)*(v2*k1)*t_metric &
- (k2*v1)*((v2.tprod.k1) + (k1.tprod.v2)) &
- (k1*v2)*((v1.tprod.k2) + (k2.tprod.v1)) &
+ (v1*v2)*((k1.tprod.k2) + (k2.tprod.k1)))
!!! Unitarity gauge: xi -> Infinity
!!! + (1.0_default/xi) * ( &
!!! ((k1*v1)*(k1*v2) + (k2*v1)*(k2*v2) + (k1*v1)*(k2*v2))* &
!!! t_metric) - (k1*v1) * ((k1.tprod.v2) + (v2.tprod.k1)) &
!!! - (k2*v2) * ((k2.tprod.v1) + (v1.tprod.k2)))
end function grav_vv
@ \section{Tensor Couplings}
<<Declaration of couplings>>=
public :: t2_vv, v_t2v
@ \section{Scalar-Vector Dim-5 Couplings}
<<Declaration of couplings>>=
-public :: phi_vv, v_phiv
+public :: phi_vv, v_phiv, phi_u_vv, v_u_phiv
@
<<Implementation of couplings>>=
pure function phi_vv (g, k1, k2, v1, v2) result (phi)
complex(kind=default), intent(in) :: g
type(momentum), intent(in) :: k1, k2
type(vector), intent(in) :: v1, v2
complex(kind=default) :: phi
phi = g * pseudo_scalar (k1, v1, k2, v2)
end function phi_vv
@
<<Implementation of couplings>>=
pure function v_phiv (g, phi, k1, k2, v) result (w)
complex(kind=default), intent(in) :: g, phi
type(vector), intent(in) :: v
type(momentum), intent(in) :: k1, k2
type(vector) :: w
w = g * phi * pseudo_vector (k1, k2, v)
end function v_phiv
@
<<Implementation of couplings>>=
+pure function phi_u_vv (g, k1, k2, v1, v2) result (phi)
+ complex(kind=default), intent(in) :: g
+ type(momentum), intent(in) :: k1, k2
+ type(vector), intent(in) :: v1, v2
+ complex(kind=default) :: phi
+ phi = g * ((k1*v2)*((-(k1+k2))*v1) + &
+ (k2*v1)*((-(k1+k2))*v2) + &
+ (((k1+k2)*(k1+k2)) * (v1*v2)))
+end function phi_u_vv
+@
+<<Implementation of couplings>>=
+pure function v_u_phiv (g, phi, k1, k2, v) result (w)
+ complex(kind=default), intent(in) :: g, phi
+ type(vector), intent(in) :: v
+ type(momentum), intent(in) :: k1, k2
+ type(vector) :: w
+ w = g * phi * ((k1*v)*k2 + &
+ ((-(k1+k2))*v)*k1 + &
+ ((k1*k1)*v))
+end function v_u_phiv
+@
+<<Implementation of couplings>>=
pure function t2_vv (g, v1, v2) result (t)
complex(kind=default), intent(in) :: g
type(vector), intent(in) :: v1, v2
type(tensor) :: t
type(tensor) :: tmp
tmp = v1.tprod.v2
t%t = g * (tmp%t + transpose (tmp%t))
end function t2_vv
@
<<Implementation of couplings>>=
pure function v_t2v (g, t, v) result (tv)
complex(kind=default), intent(in) :: g
type(tensor), intent(in) :: t
type(vector), intent(in) :: v
type(vector) :: tv
type(tensor) :: tmp
tmp%t = t%t + transpose (t%t)
tv = g * (tmp * v)
end function v_t2v
@
<<Declaration of couplings>>=
public :: t2_vv_d5_1, v_t2v_d5_1
@
<<Implementation of couplings>>=
pure function t2_vv_d5_1 (g, v1, k1, v2, k2) result (t)
complex(kind=default), intent(in) :: g
type(vector), intent(in) :: v1, v2
type(momentum), intent(in) :: k1, k2
type(tensor) :: t
t = (g * (v1 * v2)) * (k1-k2).tprod.(k1-k2)
end function t2_vv_d5_1
@
<<Implementation of couplings>>=
pure function v_t2v_d5_1 (g, t1, k1, v2, k2) result (tv)
complex(kind=default), intent(in) :: g
type(tensor), intent(in) :: t1
type(vector), intent(in) :: v2
type(momentum), intent(in) :: k1, k2
type(vector) :: tv
tv = (g * ((k1+2*k2).tprod.(k1+2*k2) * t1)) * v2
end function v_t2v_d5_1
@
<<Declaration of couplings>>=
public :: t2_vv_d5_2, v_t2v_d5_2
@
<<Implementation of couplings>>=
pure function t2_vv_d5_2 (g, v1, k1, v2, k2) result (t)
complex(kind=default), intent(in) :: g
type(vector), intent(in) :: v1, v2
type(momentum), intent(in) :: k1, k2
type(tensor) :: t
t = (g * (k2 * v1)) * (k2-k1).tprod.v2
t%t = t%t + transpose (t%t)
end function t2_vv_d5_2
@
<<Implementation of couplings>>=
pure function v_t2v_d5_2 (g, t1, k1, v2, k2) result (tv)
complex(kind=default), intent(in) :: g
type(tensor), intent(in) :: t1
type(vector), intent(in) :: v2
type(momentum), intent(in) :: k1, k2
type(vector) :: tv
type(tensor) :: tmp
type(momentum) :: k1_k2, k1_2k2
k1_k2 = k1 + k2
k1_2k2 = k1_k2 + k2
tmp%t = t1%t + transpose (t1%t)
tv = (g * (k1_k2 * v2)) * (k1_2k2 * tmp)
end function v_t2v_d5_2
@
<<Declaration of couplings>>=
public :: t2_vv_d7, v_t2v_d7
@
<<Implementation of couplings>>=
pure function t2_vv_d7 (g, v1, k1, v2, k2) result (t)
complex(kind=default), intent(in) :: g
type(vector), intent(in) :: v1, v2
type(momentum), intent(in) :: k1, k2
type(tensor) :: t
t = (g * (k2 * v1) * (k1 * v2)) * (k1-k2).tprod.(k1-k2)
end function t2_vv_d7
@
<<Implementation of couplings>>=
pure function v_t2v_d7 (g, t1, k1, v2, k2) result (tv)
complex(kind=default), intent(in) :: g
type(tensor), intent(in) :: t1
type(vector), intent(in) :: v2
type(momentum), intent(in) :: k1, k2
type(vector) :: tv
type(vector) :: k1_k2, k1_2k2
k1_k2 = k1 + k2
k1_2k2 = k1_k2 + k2
tv = (- g * (k1_k2 * v2) * (k1_2k2.tprod.k1_2k2 * t1)) * k2
end function v_t2v_d7
@ \section{Spinor Couplings}
<<[[omega_spinor_couplings.f90]]>>=
<<Copyleft>>
module omega_spinor_couplings
use kinds
use constants
use omega_spinors
use omega_vectors
use omega_tensors
use omega_couplings
implicit none
private
<<Declaration of spinor on shell wave functions>>
<<Declaration of spinor off shell wave functions>>
<<Declaration of spinor currents>>
<<Declaration of spinor propagators>>
integer, parameter, public :: omega_spinor_cpls_2010_01_A = 0
contains
<<Implementation of spinor on shell wave functions>>
<<Implementation of spinor off shell wave functions>>
<<Implementation of spinor currents>>
<<Implementation of spinor propagators>>
end module omega_spinor_couplings
@
See table~\ref{tab:fermionic-currents} for the names of Fortran
functions. We could have used long names instead, but this would
increase the chance of running past continuation line limits without
adding much to the legibility.
@
\subsection{Fermionic Vector and Axial Couplings}
There's more than one chiral representation. This one is compatible
with HELAS~\cite{HELAS}.
\begin{equation}
\gamma^0 = \begin{pmatrix} 0 & \mathbf{1} \\ \mathbf{1} & 0 \end{pmatrix},\;
\gamma^i = \begin{pmatrix} 0 & \sigma^i \\ -\sigma^i & 0 \end{pmatrix},\;
\gamma_5 = i\gamma^0\gamma^1\gamma^2\gamma^3
= \begin{pmatrix} -\mathbf{1} & 0 \\ 0 & \mathbf{1} \end{pmatrix}
\end{equation}
Therefore
\begin{subequations}
\begin{align}
g_S + g_P\gamma_5 &=
\begin{pmatrix}
g_S - g_P & 0 & 0 & 0 \\
0 & g_S - g_P & 0 & 0 \\
0 & 0 & g_S + g_P & 0 \\
0 & 0 & 0 & g_S + g_P
\end{pmatrix} \\
g_V\gamma^0 - g_A\gamma^0\gamma_5 &=
\begin{pmatrix}
0 & 0 & g_V - g_A & 0 \\
0 & 0 & 0 & g_V - g_A \\
g_V + g_A & 0 & 0 & 0 \\
0 & g_V + g_A & 0 & 0
\end{pmatrix} \\
g_V\gamma^1 - g_A\gamma^1\gamma_5 &=
\begin{pmatrix}
0 & 0 & 0 & g_V - g_A \\
0 & 0 & g_V - g_A & 0 \\
0 & - g_V - g_A & 0 & 0 \\
- g_V - g_A & 0 & 0 & 0
\end{pmatrix} \\
g_V\gamma^2 - g_A\gamma^2\gamma_5 &=
\begin{pmatrix}
0 & 0 & 0 & -\ii(g_V - g_A) \\
0 & 0 & \ii(g_V - g_A) & 0 \\
0 & \ii(g_V + g_A) & 0 & 0 \\
-\ii(g_V + g_A) & 0 & 0 & 0
\end{pmatrix} \\
g_V\gamma^3 - g_A\gamma^3\gamma_5 &=
\begin{pmatrix}
0 & 0 & g_V - g_A & 0 \\
0 & 0 & 0 & - g_V + g_A \\
- g_V - g_A & 0 & 0 & 0 \\
0 & g_V + g_A & 0 & 0
\end{pmatrix}
\end{align}
\end{subequations}
\begin{table}
\begin{center}
\begin{tabular}{>{$}l<{$}|>{$}l<{$}}
\bar\psi(g_V\gamma^\mu - g_A\gamma^\mu\gamma_5)\psi
& \text{\texttt{va\_ff}}(g_V,g_A,\bar\psi,\psi) \\
g_V\bar\psi\gamma^\mu\psi
& \text{\texttt{v\_ff}}(g_V,\bar\psi,\psi) \\
g_A\bar\psi\gamma_5\gamma^\mu\psi
& \text{\texttt{a\_ff}}(g_A,\bar\psi,\psi) \\
g_L\bar\psi\gamma^\mu(1-\gamma_5)\psi
& \text{\texttt{vl\_ff}}(g_L,\bar\psi,\psi) \\
g_R\bar\psi\gamma^\mu(1+\gamma_5)\psi
& \text{\texttt{vr\_ff}}(g_R,\bar\psi,\psi) \\\hline
\fmslash{V}(g_V - g_A\gamma_5)\psi
& \text{\texttt{f\_vaf}}(g_V,g_A,V,\psi) \\
g_V\fmslash{V}\psi
& \text{\texttt{f\_vf}}(g_V,V,\psi) \\
g_A\gamma_5\fmslash{V}\psi
& \text{\texttt{f\_af}}(g_A,V,\psi) \\
g_L\fmslash{V}(1-\gamma_5)\psi
& \text{\texttt{f\_vlf}}(g_L,V,\psi) \\
g_R\fmslash{V}(1+\gamma_5)\psi
& \text{\texttt{f\_vrf}}(g_R,V,\psi) \\\hline
\bar\psi\fmslash{V}(g_V - g_A\gamma_5)
& \text{\texttt{f\_fva}}(g_V,g_A,\bar\psi,V) \\
g_V\bar\psi\fmslash{V}
& \text{\texttt{f\_fv}}(g_V,\bar\psi,V) \\
g_A\bar\psi\gamma_5\fmslash{V}
& \text{\texttt{f\_fa}}(g_A,\bar\psi,V) \\
g_L\bar\psi\fmslash{V}(1-\gamma_5)
& \text{\texttt{f\_fvl}}(g_L,\bar\psi,V) \\
g_R\bar\psi\fmslash{V}(1+\gamma_5)
& \text{\texttt{f\_fvr}}(g_R,\bar\psi,V)
\end{tabular}
\end{center}
\caption{\label{tab:fermionic-currents}
Mnemonically abbreviated names of Fortran functions implementing
fermionic vector and axial currents.}
\end{table}
\begin{table}
\begin{center}
\begin{tabular}{>{$}l<{$}|>{$}l<{$}}
\bar\psi(g_S + g_P\gamma_5)\psi
& \text{\texttt{sp\_ff}}(g_S,g_P,\bar\psi,\psi) \\
g_S\bar\psi\psi
& \text{\texttt{s\_ff}}(g_S,\bar\psi,\psi) \\
g_P\bar\psi\gamma_5\psi
& \text{\texttt{p\_ff}}(g_P,\bar\psi,\psi) \\
g_L\bar\psi(1-\gamma_5)\psi
& \text{\texttt{sl\_ff}}(g_L,\bar\psi,\psi) \\
g_R\bar\psi(1+\gamma_5)\psi
& \text{\texttt{sr\_ff}}(g_R,\bar\psi,\psi) \\\hline
\phi(g_S + g_P\gamma_5)\psi
& \text{\texttt{f\_spf}}(g_S,g_P,\phi,\psi) \\
g_S\phi\psi
& \text{\texttt{f\_sf}}(g_S,\phi,\psi) \\
g_P\phi\gamma_5\psi
& \text{\texttt{f\_pf}}(g_P,\phi,\psi) \\
g_L\phi(1-\gamma_5)\psi
& \text{\texttt{f\_slf}}(g_L,\phi,\psi) \\
g_R\phi(1+\gamma_5)\psi
& \text{\texttt{f\_srf}}(g_R,\phi,\psi) \\\hline
\bar\psi\phi(g_S + g_P\gamma_5)
& \text{\texttt{f\_fsp}}(g_S,g_P,\bar\psi,\phi) \\
g_S\bar\psi\phi
& \text{\texttt{f\_fs}}(g_S,\bar\psi,\phi) \\
g_P\bar\psi\phi\gamma_5
& \text{\texttt{f\_fp}}(g_P,\bar\psi,\phi) \\
g_L\bar\psi\phi(1-\gamma_5)
& \text{\texttt{f\_fsl}}(g_L,\bar\psi,\phi) \\
g_R\bar\psi\phi(1+\gamma_5)
& \text{\texttt{f\_fsr}}(g_R,\bar\psi,\phi)
\end{tabular}
\end{center}
\caption{\label{tab:fermionic-scalar currents}
Mnemonically abbreviated names of Fortran functions implementing
fermionic scalar and pseudo scalar ``currents''.}
\end{table}
<<Declaration of spinor currents>>=
public :: va_ff, v_ff, a_ff, vl_ff, vr_ff, vlr_ff, grav_ff, va2_ff, &
tva_ff, tlr_ff, trl_ff, tvam_ff, tlrm_ff, trlm_ff
@
<<Implementation of spinor currents>>=
pure function va_ff (gv, ga, psibar, psi) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: gv, ga
type(conjspinor), intent(in) :: psibar
type(spinor), intent(in) :: psi
complex(kind=default) :: gl, gr
complex(kind=default) :: g13, g14, g23, g24, g31, g32, g41, g42
gl = gv + ga
gr = gv - ga
g13 = psibar%a(1)*psi%a(3)
g14 = psibar%a(1)*psi%a(4)
g23 = psibar%a(2)*psi%a(3)
g24 = psibar%a(2)*psi%a(4)
g31 = psibar%a(3)*psi%a(1)
g32 = psibar%a(3)*psi%a(2)
g41 = psibar%a(4)*psi%a(1)
g42 = psibar%a(4)*psi%a(2)
j%t = gr * ( g13 + g24) + gl * ( g31 + g42)
j%x(1) = gr * ( g14 + g23) - gl * ( g32 + g41)
j%x(2) = (gr * ( - g14 + g23) + gl * ( g32 - g41)) * (0, 1)
j%x(3) = gr * ( g13 - g24) + gl * ( - g31 + g42)
end function va_ff
@
<<Implementation of spinor currents>>=
pure function va2_ff (gva, psibar, psi) result (j)
type(vector) :: j
complex(kind=default), intent(in), dimension(2) :: gva
type(conjspinor), intent(in) :: psibar
type(spinor), intent(in) :: psi
complex(kind=default) :: gl, gr
complex(kind=default) :: g13, g14, g23, g24, g31, g32, g41, g42
gl = gva(1) + gva(2)
gr = gva(1) - gva(2)
g13 = psibar%a(1)*psi%a(3)
g14 = psibar%a(1)*psi%a(4)
g23 = psibar%a(2)*psi%a(3)
g24 = psibar%a(2)*psi%a(4)
g31 = psibar%a(3)*psi%a(1)
g32 = psibar%a(3)*psi%a(2)
g41 = psibar%a(4)*psi%a(1)
g42 = psibar%a(4)*psi%a(2)
j%t = gr * ( g13 + g24) + gl * ( g31 + g42)
j%x(1) = gr * ( g14 + g23) - gl * ( g32 + g41)
j%x(2) = (gr * ( - g14 + g23) + gl * ( g32 - g41)) * (0, 1)
j%x(3) = gr * ( g13 - g24) + gl * ( - g31 + g42)
end function va2_ff
@
<<Implementation of spinor currents>>=
pure function tva_ff (gv, ga, psibar, psi) result (t)
type(tensor2odd) :: t
complex(kind=default), intent(in) :: gv, ga
type(conjspinor), intent(in) :: psibar
type(spinor), intent(in) :: psi
complex(kind=default) :: gl, gr
complex(kind=default) :: g12, g21, g1m2, g34, g43, g3m4
gr = gv + ga
gl = gv - ga
g12 = psibar%a(1)*psi%a(2)
g21 = psibar%a(2)*psi%a(1)
g1m2 = psibar%a(1)*psi%a(1) - psibar%a(2)*psi%a(2)
g34 = psibar%a(3)*psi%a(4)
g43 = psibar%a(4)*psi%a(3)
g3m4 = psibar%a(3)*psi%a(3) - psibar%a(4)*psi%a(4)
t%e(1) = (gl * ( - g12 - g21) + gr * ( g34 + g43)) * (0, 1)
t%e(2) = gl * ( - g12 + g21) + gr * ( g34 - g43)
t%e(3) = (gl * ( - g1m2 ) + gr * ( g3m4 )) * (0, 1)
t%b(1) = gl * ( g12 + g21) + gr * ( g34 + g43)
t%b(2) = (gl * ( - g12 + g21) + gr * ( - g34 + g43)) * (0, 1)
t%b(3) = gl * ( g1m2 ) + gr * ( g3m4 )
end function tva_ff
@
<<Implementation of spinor currents>>=
pure function tlr_ff (gl, gr, psibar, psi) result (t)
type(tensor2odd) :: t
complex(kind=default), intent(in) :: gl, gr
type(conjspinor), intent(in) :: psibar
type(spinor), intent(in) :: psi
t = tva_ff (gr+gl, gr-gl, psibar, psi)
end function tlr_ff
@
<<Implementation of spinor currents>>=
pure function trl_ff (gr, gl, psibar, psi) result (t)
type(tensor2odd) :: t
complex(kind=default), intent(in) :: gl, gr
type(conjspinor), intent(in) :: psibar
type(spinor), intent(in) :: psi
t = tva_ff (gr+gl, gr-gl, psibar, psi)
end function trl_ff
@
<<Implementation of spinor currents>>=
pure function tvam_ff (gv, ga, psibar, psi, p) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: gv, ga
type(conjspinor), intent(in) :: psibar
type(spinor), intent(in) :: psi
type(momentum), intent(in) :: p
j = (tva_ff(gv, ga, psibar, psi) * p) * (0,1)
end function tvam_ff
@
<<Implementation of spinor currents>>=
pure function tlrm_ff (gl, gr, psibar, psi, p) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: gl, gr
type(conjspinor), intent(in) :: psibar
type(spinor), intent(in) :: psi
type(momentum), intent(in) :: p
j = tvam_ff (gr+gl, gr-gl, psibar, psi, p)
end function tlrm_ff
@
<<Implementation of spinor currents>>=
pure function trlm_ff (gr, gl, psibar, psi, p) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: gl, gr
type(conjspinor), intent(in) :: psibar
type(spinor), intent(in) :: psi
type(momentum), intent(in) :: p
j = tvam_ff (gr+gl, gr-gl, psibar, psi, p)
end function trlm_ff
@ Special cases that avoid some multiplications
<<Implementation of spinor currents>>=
pure function v_ff (gv, psibar, psi) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: gv
type(conjspinor), intent(in) :: psibar
type(spinor), intent(in) :: psi
complex(kind=default) :: g13, g14, g23, g24, g31, g32, g41, g42
g13 = psibar%a(1)*psi%a(3)
g14 = psibar%a(1)*psi%a(4)
g23 = psibar%a(2)*psi%a(3)
g24 = psibar%a(2)*psi%a(4)
g31 = psibar%a(3)*psi%a(1)
g32 = psibar%a(3)*psi%a(2)
g41 = psibar%a(4)*psi%a(1)
g42 = psibar%a(4)*psi%a(2)
j%t = gv * ( g13 + g24 + g31 + g42)
j%x(1) = gv * ( g14 + g23 - g32 - g41)
j%x(2) = gv * ( - g14 + g23 + g32 - g41) * (0, 1)
j%x(3) = gv * ( g13 - g24 - g31 + g42)
end function v_ff
@
<<Implementation of spinor currents>>=
pure function a_ff (ga, psibar, psi) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: ga
type(conjspinor), intent(in) :: psibar
type(spinor), intent(in) :: psi
complex(kind=default) :: g13, g14, g23, g24, g31, g32, g41, g42
g13 = psibar%a(1)*psi%a(3)
g14 = psibar%a(1)*psi%a(4)
g23 = psibar%a(2)*psi%a(3)
g24 = psibar%a(2)*psi%a(4)
g31 = psibar%a(3)*psi%a(1)
g32 = psibar%a(3)*psi%a(2)
g41 = psibar%a(4)*psi%a(1)
g42 = psibar%a(4)*psi%a(2)
j%t = ga * ( - g13 - g24 + g31 + g42)
j%x(1) = - ga * ( g14 + g23 + g32 + g41)
j%x(2) = ga * ( g14 - g23 + g32 - g41) * (0, 1)
j%x(3) = ga * ( - g13 + g24 - g31 + g42)
end function a_ff
@
<<Implementation of spinor currents>>=
pure function vl_ff (gl, psibar, psi) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: gl
type(conjspinor), intent(in) :: psibar
type(spinor), intent(in) :: psi
complex(kind=default) :: gl2
complex(kind=default) :: g31, g32, g41, g42
gl2 = 2 * gl
g31 = psibar%a(3)*psi%a(1)
g32 = psibar%a(3)*psi%a(2)
g41 = psibar%a(4)*psi%a(1)
g42 = psibar%a(4)*psi%a(2)
j%t = gl2 * ( g31 + g42)
j%x(1) = - gl2 * ( g32 + g41)
j%x(2) = gl2 * ( g32 - g41) * (0, 1)
j%x(3) = gl2 * ( - g31 + g42)
end function vl_ff
@
<<Implementation of spinor currents>>=
pure function vr_ff (gr, psibar, psi) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: gr
type(conjspinor), intent(in) :: psibar
type(spinor), intent(in) :: psi
complex(kind=default) :: gr2
complex(kind=default) :: g13, g14, g23, g24
gr2 = 2 * gr
g13 = psibar%a(1)*psi%a(3)
g14 = psibar%a(1)*psi%a(4)
g23 = psibar%a(2)*psi%a(3)
g24 = psibar%a(2)*psi%a(4)
j%t = gr2 * ( g13 + g24)
j%x(1) = gr2 * ( g14 + g23)
j%x(2) = gr2 * ( - g14 + g23) * (0, 1)
j%x(3) = gr2 * ( g13 - g24)
end function vr_ff
@
<<Implementation of spinor currents>>=
pure function grav_ff (g, m, kb, k, psibar, psi) result (j)
type(tensor) :: j
complex(kind=default), intent(in) :: g
real(kind=default), intent(in) :: m
type(conjspinor), intent(in) :: psibar
type(spinor), intent(in) :: psi
type(momentum), intent(in) :: kb, k
complex(kind=default) :: g2, g8, c_dum
type(vector) :: v_dum
type(tensor) :: t_metric
t_metric%t = 0
t_metric%t(0,0) = 1.0_default
t_metric%t(1,1) = - 1.0_default
t_metric%t(2,2) = - 1.0_default
t_metric%t(3,3) = - 1.0_default
g2 = g/2.0_default
g8 = g/8.0_default
v_dum = v_ff(g8, psibar, psi)
c_dum = (- m) * s_ff (g2, psibar, psi) - (kb+k)*v_dum
j = c_dum*t_metric - (((kb+k).tprod.v_dum) + &
(v_dum.tprod.(kb+k)))
end function grav_ff
@
\begin{equation}
g_L\gamma_\mu(1-\gamma_5) + g_R\gamma_\mu(1+\gamma_5)
= (g_L+g_R)\gamma_\mu - (g_L-g_R)\gamma_\mu\gamma_5
= g_V\gamma_\mu - g_A\gamma_\mu\gamma_5
\end{equation}
\ldots{} give the compiler the benefit of the doubt that it will
optimize the function all. If not, we could inline it \ldots
<<Implementation of spinor currents>>=
pure function vlr_ff (gl, gr, psibar, psi) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: gl, gr
type(conjspinor), intent(in) :: psibar
type(spinor), intent(in) :: psi
j = va_ff (gl+gr, gl-gr, psibar, psi)
end function vlr_ff
@
and
\begin{equation}
\fmslash{v} - \fmslash{a}\gamma_5 =
\begin{pmatrix}
0 & 0 & v_- - a_- & - v^* + a^* \\
0 & 0 & - v + a & v_+ - a_+ \\
v_+ + a_+ & v^* + a^* & 0 & 0 \\
v + a & v_- + a_- & 0 & 0
\end{pmatrix}
\end{equation}
with $v_\pm=v_0\pm v_3$, $a_\pm=a_0\pm a_3$, $v=v_1+\ii v_2$,
$v^*=v_1-\ii v_2$, $a=a_1+\ii a_2$, and $a^*=a_1-\ii a_2$. But note
that~$\cdot^*$ is \emph{not} complex conjugation for complex~$v_\mu$
or~$a_\mu$.
<<Declaration of spinor currents>>=
public :: f_vaf, f_vf, f_af, f_vlf, f_vrf, f_vlrf, f_va2f, &
f_tvaf, f_tlrf, f_trlf, f_tvamf, f_tlrmf, f_trlmf
@
<<Implementation of spinor currents>>=
pure function f_vaf (gv, ga, v, psi) result (vpsi)
type(spinor) :: vpsi
complex(kind=default), intent(in) :: gv, ga
type(vector), intent(in) :: v
type(spinor), intent(in) :: psi
complex(kind=default) :: gl, gr
complex(kind=default) :: vp, vm, v12, v12s
gl = gv + ga
gr = gv - ga
vp = v%t + v%x(3)
vm = v%t - v%x(3)
v12 = v%x(1) + (0,1)*v%x(2)
v12s = v%x(1) - (0,1)*v%x(2)
vpsi%a(1) = gr * ( vm * psi%a(3) - v12s * psi%a(4))
vpsi%a(2) = gr * ( - v12 * psi%a(3) + vp * psi%a(4))
vpsi%a(3) = gl * ( vp * psi%a(1) + v12s * psi%a(2))
vpsi%a(4) = gl * ( v12 * psi%a(1) + vm * psi%a(2))
end function f_vaf
@
<<Implementation of spinor currents>>=
pure function f_va2f (gva, v, psi) result (vpsi)
type(spinor) :: vpsi
complex(kind=default), intent(in), dimension(2) :: gva
type(vector), intent(in) :: v
type(spinor), intent(in) :: psi
complex(kind=default) :: gl, gr
complex(kind=default) :: vp, vm, v12, v12s
gl = gva(1) + gva(2)
gr = gva(1) - gva(2)
vp = v%t + v%x(3)
vm = v%t - v%x(3)
v12 = v%x(1) + (0,1)*v%x(2)
v12s = v%x(1) - (0,1)*v%x(2)
vpsi%a(1) = gr * ( vm * psi%a(3) - v12s * psi%a(4))
vpsi%a(2) = gr * ( - v12 * psi%a(3) + vp * psi%a(4))
vpsi%a(3) = gl * ( vp * psi%a(1) + v12s * psi%a(2))
vpsi%a(4) = gl * ( v12 * psi%a(1) + vm * psi%a(2))
end function f_va2f
@
<<Implementation of spinor currents>>=
pure function f_tvaf (gv, ga, t, psi) result (tpsi)
type(spinor) :: tpsi
complex(kind=default), intent(in) :: gv, ga
type(tensor2odd), intent(in) :: t
type(spinor), intent(in) :: psi
complex(kind=default) :: gl, gr
complex(kind=default) :: e21, e21s, b12, b12s, be3, be3s
gr = gv + ga
gl = gv - ga
e21 = t%e(2) + t%e(1)*(0,1)
e21s = t%e(2) - t%e(1)*(0,1)
b12 = t%b(1) + t%b(2)*(0,1)
b12s = t%b(1) - t%b(2)*(0,1)
be3 = t%b(3) + t%e(3)*(0,1)
be3s = t%b(3) - t%e(3)*(0,1)
tpsi%a(1) = 2*gl * ( psi%a(1) * be3 + psi%a(2) * ( e21 +b12s))
tpsi%a(2) = 2*gl * ( - psi%a(2) * be3 + psi%a(1) * (-e21s+b12 ))
tpsi%a(3) = 2*gr * ( psi%a(3) * be3s + psi%a(4) * (-e21 +b12s))
tpsi%a(4) = 2*gr * ( - psi%a(4) * be3s + psi%a(3) * ( e21s+b12 ))
end function f_tvaf
@
<<Implementation of spinor currents>>=
pure function f_tlrf (gl, gr, t, psi) result (tpsi)
type(spinor) :: tpsi
complex(kind=default), intent(in) :: gl, gr
type(tensor2odd), intent(in) :: t
type(spinor), intent(in) :: psi
tpsi = f_tvaf (gr+gl, gr-gl, t, psi)
end function f_tlrf
@
<<Implementation of spinor currents>>=
pure function f_trlf (gr, gl, t, psi) result (tpsi)
type(spinor) :: tpsi
complex(kind=default), intent(in) :: gl, gr
type(tensor2odd), intent(in) :: t
type(spinor), intent(in) :: psi
tpsi = f_tvaf (gr+gl, gr-gl, t, psi)
end function f_trlf
@
<<Implementation of spinor currents>>=
pure function f_tvamf (gv, ga, v, psi, k) result (vpsi)
type(spinor) :: vpsi
complex(kind=default), intent(in) :: gv, ga
type(vector), intent(in) :: v
type(spinor), intent(in) :: psi
type(momentum), intent(in) :: k
type(tensor2odd) :: t
t = (v.wedge.k) * (0, 0.5)
vpsi = f_tvaf(gv, ga, t, psi)
end function f_tvamf
@
<<Implementation of spinor currents>>=
pure function f_tlrmf (gl, gr, v, psi, k) result (vpsi)
type(spinor) :: vpsi
complex(kind=default), intent(in) :: gl, gr
type(vector), intent(in) :: v
type(spinor), intent(in) :: psi
type(momentum), intent(in) :: k
vpsi = f_tvamf (gr+gl, gr-gl, v, psi, k)
end function f_tlrmf
@
<<Implementation of spinor currents>>=
pure function f_trlmf (gr, gl, v, psi, k) result (vpsi)
type(spinor) :: vpsi
complex(kind=default), intent(in) :: gl, gr
type(vector), intent(in) :: v
type(spinor), intent(in) :: psi
type(momentum), intent(in) :: k
vpsi = f_tvamf (gr+gl, gr-gl, v, psi, k)
end function f_trlmf
@
<<Implementation of spinor currents>>=
pure function f_vf (gv, v, psi) result (vpsi)
type(spinor) :: vpsi
complex(kind=default), intent(in) :: gv
type(vector), intent(in) :: v
type(spinor), intent(in) :: psi
complex(kind=default) :: vp, vm, v12, v12s
vp = v%t + v%x(3)
vm = v%t - v%x(3)
v12 = v%x(1) + (0,1)*v%x(2)
v12s = v%x(1) - (0,1)*v%x(2)
vpsi%a(1) = gv * ( vm * psi%a(3) - v12s * psi%a(4))
vpsi%a(2) = gv * ( - v12 * psi%a(3) + vp * psi%a(4))
vpsi%a(3) = gv * ( vp * psi%a(1) + v12s * psi%a(2))
vpsi%a(4) = gv * ( v12 * psi%a(1) + vm * psi%a(2))
end function f_vf
@
<<Implementation of spinor currents>>=
pure function f_af (ga, v, psi) result (vpsi)
type(spinor) :: vpsi
complex(kind=default), intent(in) :: ga
type(vector), intent(in) :: v
type(spinor), intent(in) :: psi
complex(kind=default) :: vp, vm, v12, v12s
vp = v%t + v%x(3)
vm = v%t - v%x(3)
v12 = v%x(1) + (0,1)*v%x(2)
v12s = v%x(1) - (0,1)*v%x(2)
vpsi%a(1) = ga * ( - vm * psi%a(3) + v12s * psi%a(4))
vpsi%a(2) = ga * ( v12 * psi%a(3) - vp * psi%a(4))
vpsi%a(3) = ga * ( vp * psi%a(1) + v12s * psi%a(2))
vpsi%a(4) = ga * ( v12 * psi%a(1) + vm * psi%a(2))
end function f_af
@
<<Implementation of spinor currents>>=
pure function f_vlf (gl, v, psi) result (vpsi)
type(spinor) :: vpsi
complex(kind=default), intent(in) :: gl
type(vector), intent(in) :: v
type(spinor), intent(in) :: psi
complex(kind=default) :: gl2
complex(kind=default) :: vp, vm, v12, v12s
gl2 = 2 * gl
vp = v%t + v%x(3)
vm = v%t - v%x(3)
v12 = v%x(1) + (0,1)*v%x(2)
v12s = v%x(1) - (0,1)*v%x(2)
vpsi%a(1) = 0
vpsi%a(2) = 0
vpsi%a(3) = gl2 * ( vp * psi%a(1) + v12s * psi%a(2))
vpsi%a(4) = gl2 * ( v12 * psi%a(1) + vm * psi%a(2))
end function f_vlf
@
<<Implementation of spinor currents>>=
pure function f_vrf (gr, v, psi) result (vpsi)
type(spinor) :: vpsi
complex(kind=default), intent(in) :: gr
type(vector), intent(in) :: v
type(spinor), intent(in) :: psi
complex(kind=default) :: gr2
complex(kind=default) :: vp, vm, v12, v12s
gr2 = 2 * gr
vp = v%t + v%x(3)
vm = v%t - v%x(3)
v12 = v%x(1) + (0,1)*v%x(2)
v12s = v%x(1) - (0,1)*v%x(2)
vpsi%a(1) = gr2 * ( vm * psi%a(3) - v12s * psi%a(4))
vpsi%a(2) = gr2 * ( - v12 * psi%a(3) + vp * psi%a(4))
vpsi%a(3) = 0
vpsi%a(4) = 0
end function f_vrf
@
<<Implementation of spinor currents>>=
pure function f_vlrf (gl, gr, v, psi) result (vpsi)
type(spinor) :: vpsi
complex(kind=default), intent(in) :: gl, gr
type(vector), intent(in) :: v
type(spinor), intent(in) :: psi
vpsi = f_vaf (gl+gr, gl-gr, v, psi)
end function f_vlrf
@
<<Declaration of spinor currents>>=
public :: f_fva, f_fv, f_fa, f_fvl, f_fvr, f_fvlr, f_fva2, &
f_ftva, f_ftlr, f_ftrl, f_ftvam, f_ftlrm, f_ftrlm
@
<<Implementation of spinor currents>>=
pure function f_fva (gv, ga, psibar, v) result (psibarv)
type(conjspinor) :: psibarv
complex(kind=default), intent(in) :: gv, ga
type(conjspinor), intent(in) :: psibar
type(vector), intent(in) :: v
complex(kind=default) :: gl, gr
complex(kind=default) :: vp, vm, v12, v12s
gl = gv + ga
gr = gv - ga
vp = v%t + v%x(3)
vm = v%t - v%x(3)
v12 = v%x(1) + (0,1)*v%x(2)
v12s = v%x(1) - (0,1)*v%x(2)
psibarv%a(1) = gl * ( psibar%a(3) * vp + psibar%a(4) * v12)
psibarv%a(2) = gl * ( psibar%a(3) * v12s + psibar%a(4) * vm )
psibarv%a(3) = gr * ( psibar%a(1) * vm - psibar%a(2) * v12)
psibarv%a(4) = gr * ( - psibar%a(1) * v12s + psibar%a(2) * vp )
end function f_fva
@
<<Implementation of spinor currents>>=
pure function f_fva2 (gva, psibar, v) result (psibarv)
type(conjspinor) :: psibarv
complex(kind=default), intent(in), dimension(2) :: gva
type(conjspinor), intent(in) :: psibar
type(vector), intent(in) :: v
complex(kind=default) :: gl, gr
complex(kind=default) :: vp, vm, v12, v12s
gl = gva(1) + gva(2)
gr = gva(1) - gva(2)
vp = v%t + v%x(3)
vm = v%t - v%x(3)
v12 = v%x(1) + (0,1)*v%x(2)
v12s = v%x(1) - (0,1)*v%x(2)
psibarv%a(1) = gl * ( psibar%a(3) * vp + psibar%a(4) * v12)
psibarv%a(2) = gl * ( psibar%a(3) * v12s + psibar%a(4) * vm )
psibarv%a(3) = gr * ( psibar%a(1) * vm - psibar%a(2) * v12)
psibarv%a(4) = gr * ( - psibar%a(1) * v12s + psibar%a(2) * vp )
end function f_fva2
@
<<Implementation of spinor currents>>=
pure function f_ftva (gv, ga, psibar, t) result (psibart)
type(conjspinor) :: psibart
complex(kind=default), intent(in) :: gv, ga
type(conjspinor), intent(in) :: psibar
type(tensor2odd), intent(in) :: t
complex(kind=default) :: gl, gr
complex(kind=default) :: e21, e21s, b12, b12s, be3, be3s
gr = gv + ga
gl = gv - ga
e21 = t%e(2) + t%e(1)*(0,1)
e21s = t%e(2) - t%e(1)*(0,1)
b12 = t%b(1) + t%b(2)*(0,1)
b12s = t%b(1) - t%b(2)*(0,1)
be3 = t%b(3) + t%e(3)*(0,1)
be3s = t%b(3) - t%e(3)*(0,1)
psibart%a(1) = 2*gl * ( psibar%a(1) * be3 + psibar%a(2) * (-e21s+b12 ))
psibart%a(2) = 2*gl * ( - psibar%a(2) * be3 + psibar%a(1) * ( e21 +b12s))
psibart%a(3) = 2*gr * ( psibar%a(3) * be3s + psibar%a(4) * ( e21s+b12 ))
psibart%a(4) = 2*gr * ( - psibar%a(4) * be3s + psibar%a(3) * (-e21 +b12s))
end function f_ftva
@
<<Implementation of spinor currents>>=
pure function f_ftlr (gl, gr, psibar, t) result (psibart)
type(conjspinor) :: psibart
complex(kind=default), intent(in) :: gl, gr
type(conjspinor), intent(in) :: psibar
type(tensor2odd), intent(in) :: t
psibart = f_ftva (gr+gl, gr-gl, psibar, t)
end function f_ftlr
@
<<Implementation of spinor currents>>=
pure function f_ftrl (gr, gl, psibar, t) result (psibart)
type(conjspinor) :: psibart
complex(kind=default), intent(in) :: gl, gr
type(conjspinor), intent(in) :: psibar
type(tensor2odd), intent(in) :: t
psibart = f_ftva (gr+gl, gr-gl, psibar, t)
end function f_ftrl
@
<<Implementation of spinor currents>>=
pure function f_ftvam (gv, ga, psibar, v, k) result (psibarv)
type(conjspinor) :: psibarv
complex(kind=default), intent(in) :: gv, ga
type(conjspinor), intent(in) :: psibar
type(vector), intent(in) :: v
type(momentum), intent(in) :: k
type(tensor2odd) :: t
t = (v.wedge.k) * (0, 0.5)
psibarv = f_ftva(gv, ga, psibar, t)
end function f_ftvam
@
<<Implementation of spinor currents>>=
pure function f_ftlrm (gl, gr, psibar, v, k) result (psibarv)
type(conjspinor) :: psibarv
complex(kind=default), intent(in) :: gl, gr
type(conjspinor), intent(in) :: psibar
type(vector), intent(in) :: v
type(momentum), intent(in) :: k
psibarv = f_ftvam (gr+gl, gr-gl, psibar, v, k)
end function f_ftlrm
@
<<Implementation of spinor currents>>=
pure function f_ftrlm (gr, gl, psibar, v, k) result (psibarv)
type(conjspinor) :: psibarv
complex(kind=default), intent(in) :: gl, gr
type(conjspinor), intent(in) :: psibar
type(vector), intent(in) :: v
type(momentum), intent(in) :: k
psibarv = f_ftvam (gr+gl, gr-gl, psibar, v, k)
end function f_ftrlm
@
<<Implementation of spinor currents>>=
pure function f_fv (gv, psibar, v) result (psibarv)
type(conjspinor) :: psibarv
complex(kind=default), intent(in) :: gv
type(conjspinor), intent(in) :: psibar
type(vector), intent(in) :: v
complex(kind=default) :: vp, vm, v12, v12s
vp = v%t + v%x(3)
vm = v%t - v%x(3)
v12 = v%x(1) + (0,1)*v%x(2)
v12s = v%x(1) - (0,1)*v%x(2)
psibarv%a(1) = gv * ( psibar%a(3) * vp + psibar%a(4) * v12)
psibarv%a(2) = gv * ( psibar%a(3) * v12s + psibar%a(4) * vm )
psibarv%a(3) = gv * ( psibar%a(1) * vm - psibar%a(2) * v12)
psibarv%a(4) = gv * ( - psibar%a(1) * v12s + psibar%a(2) * vp )
end function f_fv
@
<<Implementation of spinor currents>>=
pure function f_fa (ga, psibar, v) result (psibarv)
type(conjspinor) :: psibarv
complex(kind=default), intent(in) :: ga
type(vector), intent(in) :: v
type(conjspinor), intent(in) :: psibar
complex(kind=default) :: vp, vm, v12, v12s
vp = v%t + v%x(3)
vm = v%t - v%x(3)
v12 = v%x(1) + (0,1)*v%x(2)
v12s = v%x(1) - (0,1)*v%x(2)
psibarv%a(1) = ga * ( psibar%a(3) * vp + psibar%a(4) * v12)
psibarv%a(2) = ga * ( psibar%a(3) * v12s + psibar%a(4) * vm )
psibarv%a(3) = ga * ( - psibar%a(1) * vm + psibar%a(2) * v12)
psibarv%a(4) = ga * ( psibar%a(1) * v12s - psibar%a(2) * vp )
end function f_fa
@
<<Implementation of spinor currents>>=
pure function f_fvl (gl, psibar, v) result (psibarv)
type(conjspinor) :: psibarv
complex(kind=default), intent(in) :: gl
type(conjspinor), intent(in) :: psibar
type(vector), intent(in) :: v
complex(kind=default) :: gl2
complex(kind=default) :: vp, vm, v12, v12s
gl2 = 2 * gl
vp = v%t + v%x(3)
vm = v%t - v%x(3)
v12 = v%x(1) + (0,1)*v%x(2)
v12s = v%x(1) - (0,1)*v%x(2)
psibarv%a(1) = gl2 * ( psibar%a(3) * vp + psibar%a(4) * v12)
psibarv%a(2) = gl2 * ( psibar%a(3) * v12s + psibar%a(4) * vm )
psibarv%a(3) = 0
psibarv%a(4) = 0
end function f_fvl
@
<<Implementation of spinor currents>>=
pure function f_fvr (gr, psibar, v) result (psibarv)
type(conjspinor) :: psibarv
complex(kind=default), intent(in) :: gr
type(conjspinor), intent(in) :: psibar
type(vector), intent(in) :: v
complex(kind=default) :: gr2
complex(kind=default) :: vp, vm, v12, v12s
gr2 = 2 * gr
vp = v%t + v%x(3)
vm = v%t - v%x(3)
v12 = v%x(1) + (0,1)*v%x(2)
v12s = v%x(1) - (0,1)*v%x(2)
psibarv%a(1) = 0
psibarv%a(2) = 0
psibarv%a(3) = gr2 * ( psibar%a(1) * vm - psibar%a(2) * v12)
psibarv%a(4) = gr2 * ( - psibar%a(1) * v12s + psibar%a(2) * vp )
end function f_fvr
@
<<Implementation of spinor currents>>=
pure function f_fvlr (gl, gr, psibar, v) result (psibarv)
type(conjspinor) :: psibarv
complex(kind=default), intent(in) :: gl, gr
type(conjspinor), intent(in) :: psibar
type(vector), intent(in) :: v
psibarv = f_fva (gl+gr, gl-gr, psibar, v)
end function f_fvlr
@ \subsection{Fermionic Scalar and Pseudo Scalar Couplings}
<<Declaration of spinor currents>>=
public :: sp_ff, s_ff, p_ff, sl_ff, sr_ff, slr_ff
@
<<Implementation of spinor currents>>=
pure function sp_ff (gs, gp, psibar, psi) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: gs, gp
type(conjspinor), intent(in) :: psibar
type(spinor), intent(in) :: psi
j = (gs - gp) * (psibar%a(1)*psi%a(1) + psibar%a(2)*psi%a(2)) &
+ (gs + gp) * (psibar%a(3)*psi%a(3) + psibar%a(4)*psi%a(4))
end function sp_ff
@
<<Implementation of spinor currents>>=
pure function s_ff (gs, psibar, psi) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: gs
type(conjspinor), intent(in) :: psibar
type(spinor), intent(in) :: psi
j = gs * (psibar * psi)
end function s_ff
@
<<Implementation of spinor currents>>=
pure function p_ff (gp, psibar, psi) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: gp
type(conjspinor), intent(in) :: psibar
type(spinor), intent(in) :: psi
j = gp * ( psibar%a(3)*psi%a(3) + psibar%a(4)*psi%a(4) &
- psibar%a(1)*psi%a(1) - psibar%a(2)*psi%a(2))
end function p_ff
@
<<Implementation of spinor currents>>=
pure function sl_ff (gl, psibar, psi) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: gl
type(conjspinor), intent(in) :: psibar
type(spinor), intent(in) :: psi
j = 2 * gl * (psibar%a(1)*psi%a(1) + psibar%a(2)*psi%a(2))
end function sl_ff
@
<<Implementation of spinor currents>>=
pure function sr_ff (gr, psibar, psi) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: gr
type(conjspinor), intent(in) :: psibar
type(spinor), intent(in) :: psi
j = 2 * gr * (psibar%a(3)*psi%a(3) + psibar%a(4)*psi%a(4))
end function sr_ff
@
\begin{equation}
g_L(1-\gamma_5) + g_R(1+\gamma_5)
= (g_R+g_L) + (g_R-g_L)\gamma_5
= g_S + g_P\gamma_5
\end{equation}
<<Implementation of spinor currents>>=
pure function slr_ff (gl, gr, psibar, psi) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: gl, gr
type(conjspinor), intent(in) :: psibar
type(spinor), intent(in) :: psi
j = sp_ff (gr+gl, gr-gl, psibar, psi)
end function slr_ff
@
<<Declaration of spinor currents>>=
public :: f_spf, f_sf, f_pf, f_slf, f_srf, f_slrf
@
<<Implementation of spinor currents>>=
pure function f_spf (gs, gp, phi, psi) result (phipsi)
type(spinor) :: phipsi
complex(kind=default), intent(in) :: gs, gp
complex(kind=default), intent(in) :: phi
type(spinor), intent(in) :: psi
phipsi%a(1:2) = ((gs - gp) * phi) * psi%a(1:2)
phipsi%a(3:4) = ((gs + gp) * phi) * psi%a(3:4)
end function f_spf
@
<<Implementation of spinor currents>>=
pure function f_sf (gs, phi, psi) result (phipsi)
type(spinor) :: phipsi
complex(kind=default), intent(in) :: gs
complex(kind=default), intent(in) :: phi
type(spinor), intent(in) :: psi
phipsi%a = (gs * phi) * psi%a
end function f_sf
@
<<Implementation of spinor currents>>=
pure function f_pf (gp, phi, psi) result (phipsi)
type(spinor) :: phipsi
complex(kind=default), intent(in) :: gp
complex(kind=default), intent(in) :: phi
type(spinor), intent(in) :: psi
phipsi%a(1:2) = (- gp * phi) * psi%a(1:2)
phipsi%a(3:4) = ( gp * phi) * psi%a(3:4)
end function f_pf
@
<<Implementation of spinor currents>>=
pure function f_slf (gl, phi, psi) result (phipsi)
type(spinor) :: phipsi
complex(kind=default), intent(in) :: gl
complex(kind=default), intent(in) :: phi
type(spinor), intent(in) :: psi
phipsi%a(1:2) = (2 * gl * phi) * psi%a(1:2)
phipsi%a(3:4) = 0
end function f_slf
@
<<Implementation of spinor currents>>=
pure function f_srf (gr, phi, psi) result (phipsi)
type(spinor) :: phipsi
complex(kind=default), intent(in) :: gr
complex(kind=default), intent(in) :: phi
type(spinor), intent(in) :: psi
phipsi%a(1:2) = 0
phipsi%a(3:4) = (2 * gr * phi) * psi%a(3:4)
end function f_srf
@
<<Implementation of spinor currents>>=
pure function f_slrf (gl, gr, phi, psi) result (phipsi)
type(spinor) :: phipsi
complex(kind=default), intent(in) :: gl, gr
complex(kind=default), intent(in) :: phi
type(spinor), intent(in) :: psi
phipsi = f_spf (gr+gl, gr-gl, phi, psi)
end function f_slrf
@
<<Declaration of spinor currents>>=
public :: f_fsp, f_fs, f_fp, f_fsl, f_fsr, f_fslr
@
<<Implementation of spinor currents>>=
pure function f_fsp (gs, gp, psibar, phi) result (psibarphi)
type(conjspinor) :: psibarphi
complex(kind=default), intent(in) :: gs, gp
type(conjspinor), intent(in) :: psibar
complex(kind=default), intent(in) :: phi
psibarphi%a(1:2) = ((gs - gp) * phi) * psibar%a(1:2)
psibarphi%a(3:4) = ((gs + gp) * phi) * psibar%a(3:4)
end function f_fsp
@
<<Implementation of spinor currents>>=
pure function f_fs (gs, psibar, phi) result (psibarphi)
type(conjspinor) :: psibarphi
complex(kind=default), intent(in) :: gs
type(conjspinor), intent(in) :: psibar
complex(kind=default), intent(in) :: phi
psibarphi%a = (gs * phi) * psibar%a
end function f_fs
@
<<Implementation of spinor currents>>=
pure function f_fp (gp, psibar, phi) result (psibarphi)
type(conjspinor) :: psibarphi
complex(kind=default), intent(in) :: gp
type(conjspinor), intent(in) :: psibar
complex(kind=default), intent(in) :: phi
psibarphi%a(1:2) = (- gp * phi) * psibar%a(1:2)
psibarphi%a(3:4) = ( gp * phi) * psibar%a(3:4)
end function f_fp
@
<<Implementation of spinor currents>>=
pure function f_fsl (gl, psibar, phi) result (psibarphi)
type(conjspinor) :: psibarphi
complex(kind=default), intent(in) :: gl
type(conjspinor), intent(in) :: psibar
complex(kind=default), intent(in) :: phi
psibarphi%a(1:2) = (2 * gl * phi) * psibar%a(1:2)
psibarphi%a(3:4) = 0
end function f_fsl
@
<<Implementation of spinor currents>>=
pure function f_fsr (gr, psibar, phi) result (psibarphi)
type(conjspinor) :: psibarphi
complex(kind=default), intent(in) :: gr
type(conjspinor), intent(in) :: psibar
complex(kind=default), intent(in) :: phi
psibarphi%a(1:2) = 0
psibarphi%a(3:4) = (2 * gr * phi) * psibar%a(3:4)
end function f_fsr
@
<<Implementation of spinor currents>>=
pure function f_fslr (gl, gr, psibar, phi) result (psibarphi)
type(conjspinor) :: psibarphi
complex(kind=default), intent(in) :: gl, gr
type(conjspinor), intent(in) :: psibar
complex(kind=default), intent(in) :: phi
psibarphi = f_fsp (gr+gl, gr-gl, psibar, phi)
end function f_fslr
<<Declaration of spinor currents>>=
public :: f_gravf, f_fgrav
@
<<Implementation of spinor currents>>=
pure function f_gravf (g, m, kb, k, t, psi) result (tpsi)
type(spinor) :: tpsi
complex(kind=default), intent(in) :: g
real(kind=default), intent(in) :: m
type(spinor), intent(in) :: psi
type(tensor), intent(in) :: t
type(momentum), intent(in) :: kb, k
complex(kind=default) :: g2, g8, t_tr
type(vector) :: kkb
kkb = k + kb
g2 = g / 2.0_default
g8 = g / 8.0_default
t_tr = t%t(0,0) - t%t(1,1) - t%t(2,2) - t%t(3,3)
tpsi = (- f_sf (g2, cmplx (m,0.0, kind=default), psi) &
- f_vf ((g8*m), kkb, psi)) * t_tr - &
f_vf (g8,(t*kkb + kkb*t),psi)
end function f_gravf
@
<<Implementation of spinor currents>>=
pure function f_fgrav (g, m, kb, k, psibar, t) result (psibart)
type(conjspinor) :: psibart
complex(kind=default), intent(in) :: g
real(kind=default), intent(in) :: m
type(conjspinor), intent(in) :: psibar
type(tensor), intent(in) :: t
type(momentum), intent(in) :: kb, k
type(vector) :: kkb
complex(kind=default) :: g2, g8, t_tr
kkb = k + kb
g2 = g / 2.0_default
g8 = g / 8.0_default
t_tr = t%t(0,0) - t%t(1,1) - t%t(2,2) - t%t(3,3)
psibart = (- f_fs (g2, psibar, cmplx (m, 0.0, kind=default)) &
- f_fv ((g8 * m), psibar, kkb)) * t_tr - &
f_fv (g8,psibar,(t*kkb + kkb*t))
end function f_fgrav
@ \subsection{On Shell Wave Functions}
<<Declaration of spinor on shell wave functions>>=
public :: u, ubar, v, vbar
private :: chi_plus, chi_minus
@
\begin{subequations}
\begin{align}
\chi_+(\vec p) &=
\frac{1}{\sqrt{2|\vec p|(|\vec p|+p_3)}}
\begin{pmatrix} |\vec p|+p_3 \\ p_1 + \ii p_2 \end{pmatrix} \\
\chi_-(\vec p) &=
\frac{1}{\sqrt{2|\vec p|(|\vec p|+p_3)}}
\begin{pmatrix} - p_1 + \ii p_2 \\ |\vec p|+p_3 \end{pmatrix}
\end{align}
\end{subequations}
<<Implementation of spinor on shell wave functions>>=
pure function chi_plus (p) result (chi)
complex(kind=default), dimension(2) :: chi
type(momentum), intent(in) :: p
real(kind=default) :: pabs
pabs = sqrt (dot_product (p%x, p%x))
if (pabs + p%x(3) <= 1000 * epsilon (pabs) * pabs) then
chi = (/ cmplx ( 0.0, 0.0, kind=default), &
cmplx ( 1.0, 0.0, kind=default) /)
else
chi = 1 / sqrt (2*pabs*(pabs + p%x(3))) &
* (/ cmplx (pabs + p%x(3), kind=default), &
cmplx (p%x(1), p%x(2), kind=default) /)
end if
end function chi_plus
@
<<Implementation of spinor on shell wave functions>>=
pure function chi_minus (p) result (chi)
complex(kind=default), dimension(2) :: chi
type(momentum), intent(in) :: p
real(kind=default) :: pabs
pabs = sqrt (dot_product (p%x, p%x))
if (pabs + p%x(3) <= 1000 * epsilon (pabs) * pabs) then
chi = (/ cmplx (-1.0, 0.0, kind=default), &
cmplx ( 0.0, 0.0, kind=default) /)
else
chi = 1 / sqrt (2*pabs*(pabs + p%x(3))) &
* (/ cmplx (-p%x(1), p%x(2), kind=default), &
cmplx (pabs + p%x(3), kind=default) /)
end if
end function chi_minus
@
\begin{equation}
u_\pm(p,|m|) =
\begin{pmatrix}
\sqrt{p_0\mp|\vec p|} \cdot \chi_\pm(\vec p) \\
\sqrt{p_0\pm|\vec p|} \cdot \chi_\pm(\vec p)
\end{pmatrix}\qquad
u_\pm(p,-|m|) =
\begin{pmatrix}
- i \sqrt{p_0\mp|\vec p|} \cdot \chi_\pm(\vec p) \\
+ i \sqrt{p_0\pm|\vec p|} \cdot \chi_\pm(\vec p)
\end{pmatrix}
\end{equation}
Determining the mass from the momenta is a numerically haphazardous for
light particles. Therefore, we accept some redundancy and pass the
mass explicitely. Even if the mass is not used in the chiral
representation, we do so for symmetry with polarization vectors and to
be prepared for other representations.
<<Implementation of spinor on shell wave functions>>=
pure function u (mass, p, s) result (psi)
type(spinor) :: psi
real(kind=default), intent(in) :: mass
type(momentum), intent(in) :: p
integer, intent(in) :: s
complex(kind=default), dimension(2) :: chi
real(kind=default) :: pabs, delta, m
m = abs(mass)
pabs = sqrt (dot_product (p%x, p%x))
if (m < epsilon (m) * pabs) then
delta = 0
else
delta = sqrt (max (p%t - pabs, 0._default))
end if
select case (s)
case (1)
chi = chi_plus (p)
psi%a(1:2) = delta * chi
psi%a(3:4) = sqrt (p%t + pabs) * chi
case (-1)
chi = chi_minus (p)
psi%a(1:2) = sqrt (p%t + pabs) * chi
psi%a(3:4) = delta * chi
case default
pabs = m ! make the compiler happy and use m
psi%a = 0
end select
if (mass < 0) then
psi%a(1:2) = - imago * psi%a(1:2)
psi%a(3:4) = + imago * psi%a(3:4)
end if
end function u
@
<<Implementation of spinor on shell wave functions>>=
pure function ubar (m, p, s) result (psibar)
type(conjspinor) :: psibar
real(kind=default), intent(in) :: m
type(momentum), intent(in) :: p
integer, intent(in) :: s
type(spinor) :: psi
psi = u (m, p, s)
psibar%a(1:2) = conjg (psi%a(3:4))
psibar%a(3:4) = conjg (psi%a(1:2))
end function ubar
@
\begin{equation}
v_\pm(p) =
\begin{pmatrix}
\mp\sqrt{p_0\pm|\vec p|} \cdot \chi_\mp(\vec p) \\
\pm\sqrt{p_0\mp|\vec p|} \cdot \chi_\mp(\vec p)
\end{pmatrix}
\end{equation}
<<Implementation of spinor on shell wave functions>>=
pure function v (mass, p, s) result (psi)
type(spinor) :: psi
real(kind=default), intent(in) :: mass
type(momentum), intent(in) :: p
integer, intent(in) :: s
complex(kind=default), dimension(2) :: chi
real(kind=default) :: pabs, delta, m
m = abs(mass)
pabs = sqrt (dot_product (p%x, p%x))
if (m < epsilon (m) * pabs) then
delta = 0
else
delta = sqrt (max (p%t - pabs, 0._default))
end if
select case (s)
case (1)
chi = chi_minus (p)
psi%a(1:2) = - sqrt (p%t + pabs) * chi
psi%a(3:4) = delta * chi
case (-1)
chi = chi_plus (p)
psi%a(1:2) = delta * chi
psi%a(3:4) = - sqrt (p%t + pabs) * chi
case default
pabs = m ! make the compiler happy and use m
psi%a = 0
end select
if (mass < 0) then
psi%a(1:2) = - imago * psi%a(1:2)
psi%a(3:4) = + imago * psi%a(3:4)
end if
end function v
@
<<Implementation of spinor on shell wave functions>>=
pure function vbar (m, p, s) result (psibar)
type(conjspinor) :: psibar
real(kind=default), intent(in) :: m
type(momentum), intent(in) :: p
integer, intent(in) :: s
type(spinor) :: psi
psi = v (m, p, s)
psibar%a(1:2) = conjg (psi%a(3:4))
psibar%a(3:4) = conjg (psi%a(1:2))
end function vbar
@
\subsection{Off Shell Wave Functions}
I've just taken this over from Christian Schwinn's version.
<<Declaration of spinor off shell wave functions>>=
public :: brs_u, brs_ubar, brs_v, brs_vbar
@
The off-shell wave functions needed for gauge checking are obtained from the LSZ-formulas:
\begin{subequations}
\begin{align}
\Braket{\text{Out}|d^\dagger|\text{In}}&=i\int d^4x \bar v
e^{-ikx}(i\fmslash\partial-m)\Braket{\text{Out}|\psi|\text{In}}\\
\Braket{\text{Out}|b|\text{In}}&=-i\int d^4x \bar u
e^{ikx}(i\fmslash\partial-m)\Braket{\text{Out}|\psi|\text{In}}\\
\Braket{\text{Out}|d|\text{In}}&=
i\int d^4x \Braket{\text{Out}|\bar \psi|
\text{In}}(-i\fmslash{\overleftarrow\partial}-m)v e^{ikx}\\
\Braket{\text{Out}|b^\dagger|\text{In}}&=
-i\int d^4x \Braket{\text{Out}|\bar \psi|
\text{In}}(-i\fmslash{\overleftarrow\partial}-m)u e^{-ikx}
\end{align}
\end{subequations}
Since the relative sign between fermions and antifermions is ignored for
on-shell amplitudes we must also ignore it here, so all wavefunctions must
have a $(-i)$ factor.
In momentum space we have:
\begin{equation}
brs u(p)=(-i) (\fmslash p-m)u(p)
\end{equation}
<<Implementation of spinor off shell wave functions>>=
pure function brs_u (m, p, s) result (dpsi)
type(spinor) :: dpsi,psi
real(kind=default), intent(in) :: m
type(momentum), intent(in) :: p
integer, intent(in) :: s
type (vector)::vp
complex(kind=default), parameter :: one = (1, 0)
vp=p
psi=u(m,p,s)
dpsi=cmplx(0.0,-1.0)*(f_vf(one,vp,psi)-m*psi)
end function brs_u
@
\begin{equation}
brs v(p)=i (\fmslash p+m)v(p)
\end{equation}
<<Implementation of spinor off shell wave functions>>=
pure function brs_v (m, p, s) result (dpsi)
type(spinor) :: dpsi, psi
real(kind=default), intent(in) :: m
type(momentum), intent(in) :: p
integer, intent(in) :: s
type (vector)::vp
complex(kind=default), parameter :: one = (1, 0)
vp=p
psi=v(m,p,s)
dpsi=cmplx(0.0,1.0)*(f_vf(one,vp,psi)+m*psi)
end function brs_v
@
\begin{equation}
brs \bar{u}(p)=(-i)\bar u(p)(\fmslash p-m)
\end{equation}
<<Implementation of spinor off shell wave functions>>=
pure function brs_ubar (m, p, s)result (dpsibar)
type(conjspinor) :: dpsibar, psibar
real(kind=default), intent(in) :: m
type(momentum), intent(in) :: p
integer, intent(in) :: s
type (vector)::vp
complex(kind=default), parameter :: one = (1, 0)
vp=p
psibar=ubar(m,p,s)
dpsibar=cmplx(0.0,-1.0)*(f_fv(one,psibar,vp)-m*psibar)
end function brs_ubar
@
\begin{equation}
brs \bar{v}(p)=(i)\bar v(p)(\fmslash p+m)
\end{equation}
<<Implementation of spinor off shell wave functions>>=
pure function brs_vbar (m, p, s) result (dpsibar)
type(conjspinor) :: dpsibar,psibar
real(kind=default), intent(in) :: m
type(momentum), intent(in) :: p
integer, intent(in) :: s
type(vector)::vp
complex(kind=default), parameter :: one = (1, 0)
vp=p
psibar=vbar(m,p,s)
dpsibar=cmplx(0.0,1.0)*(f_fv(one,psibar,vp)+m*psibar)
end function brs_vbar
@
NB: The remarks on momentum flow in the propagators don't apply
here since the incoming momenta are flipped for the wave functions.
@ \subsection{Propagators}
NB: the common factor of~$\ii$ is extracted:
<<Declaration of spinor propagators>>=
public :: pr_psi, pr_psibar
public :: pj_psi, pj_psibar
public :: pg_psi, pg_psibar
@
\begin{equation}
\frac{i(-\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma}\psi
\end{equation}
NB: the sign of the momentum comes about because all momenta are
treated as \emph{outgoing} and the particle charge flow is therefore
opposite to the momentum.
<<Implementation of spinor propagators>>=
pure function pr_psi (p, m, w, psi) result (ppsi)
type(spinor) :: ppsi
type(momentum), intent(in) :: p
real(kind=default), intent(in) :: m, w
type(spinor), intent(in) :: psi
type(vector) :: vp
complex(kind=default), parameter :: one = (1, 0)
vp = p
ppsi = (1 / cmplx (p*p - m**2, m*w, kind=default)) &
* (- f_vf (one, vp, psi) + m * psi)
end function pr_psi
@
\begin{equation}
\sqrt{\frac{\pi}{M\Gamma}}
(-\fmslash{p}+m)\psi
\end{equation}
<<Implementation of spinor propagators>>=
pure function pj_psi (p, m, w, psi) result (ppsi)
type(spinor) :: ppsi
type(momentum), intent(in) :: p
real(kind=default), intent(in) :: m, w
type(spinor), intent(in) :: psi
type(vector) :: vp
complex(kind=default), parameter :: one = (1, 0)
vp = p
ppsi = (0, -1) * sqrt (PI / m / w) * (- f_vf (one, vp, psi) + m * psi)
end function pj_psi
@
<<Implementation of spinor propagators>>=
pure function pg_psi (p, m, w, psi) result (ppsi)
type(spinor) :: ppsi
type(momentum), intent(in) :: p
real(kind=default), intent(in) :: m, w
type(spinor), intent(in) :: psi
type(vector) :: vp
complex(kind=default), parameter :: one = (1, 0)
vp = p
ppsi = gauss(p*p, m, w) * (- f_vf (one, vp, psi) + m * psi)
end function pg_psi
@
\begin{equation}
\bar\psi \frac{i(\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma}
\end{equation}
NB: the sign of the momentum comes about because all momenta are
treated as \emph{outgoing} and the antiparticle charge flow is
therefore parallel to the momentum.
<<Implementation of spinor propagators>>=
pure function pr_psibar (p, m, w, psibar) result (ppsibar)
type(conjspinor) :: ppsibar
type(momentum), intent(in) :: p
real(kind=default), intent(in) :: m, w
type(conjspinor), intent(in) :: psibar
type(vector) :: vp
complex(kind=default), parameter :: one = (1, 0)
vp = p
ppsibar = (1 / cmplx (p*p - m**2, m*w, kind=default)) &
* (f_fv (one, psibar, vp) + m * psibar)
end function pr_psibar
@
\begin{equation}
\sqrt{\frac{\pi}{M\Gamma}}
\bar\psi (\fmslash{p}+m)
\end{equation}
NB: the sign of the momentum comes about because all momenta are
treated as \emph{outgoing} and the antiparticle charge flow is
therefore parallel to the momentum.
<<Implementation of spinor propagators>>=
pure function pj_psibar (p, m, w, psibar) result (ppsibar)
type(conjspinor) :: ppsibar
type(momentum), intent(in) :: p
real(kind=default), intent(in) :: m, w
type(conjspinor), intent(in) :: psibar
type(vector) :: vp
complex(kind=default), parameter :: one = (1, 0)
vp = p
ppsibar = (0, -1) * sqrt (PI / m / w) * (f_fv (one, psibar, vp) + m * psibar)
end function pj_psibar
@
<<Implementation of spinor propagators>>=
pure function pg_psibar (p, m, w, psibar) result (ppsibar)
type(conjspinor) :: ppsibar
type(momentum), intent(in) :: p
real(kind=default), intent(in) :: m, w
type(conjspinor), intent(in) :: psibar
type(vector) :: vp
complex(kind=default), parameter :: one = (1, 0)
vp = p
ppsibar = gauss (p*p, m, w) * (f_fv (one, psibar, vp) + m * psibar)
end function pg_psibar
@
\begin{equation}
\frac{i(-\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma} \sum_n \psi_n\otimes\bar\psi_n
\end{equation}
NB: the temporary variables [[psi(1:4)]] are not nice, but the compilers
should be able to optimize the unnecessary copies away. In any case, even
if the copies are performed, they are (probably) negligible compared to the
floating point multiplications anyway \ldots
<<(Not used yet) Declaration of operations for spinors>>=
type, public :: spinordyad
! private (omegalib needs access, but DON'T TOUCH IT!)
complex(kind=default), dimension(4,4) :: a
end type spinordyad
@
<<(Not used yet) Implementation of spinor propagators>>=
pure function pr_dyadleft (p, m, w, psipsibar) result (psipsibarp)
type(spinordyad) :: psipsibarp
type(momentum), intent(in) :: p
real(kind=default), intent(in) :: m, w
type(spinordyad), intent(in) :: psipsibar
integer :: i
type(vector) :: vp
type(spinor), dimension(4) :: psi
complex(kind=default) :: pole
complex(kind=default), parameter :: one = (1, 0)
vp = p
pole = 1 / cmplx (p*p - m**2, m*w, kind=default)
do i = 1, 4
psi(i)%a = psipsibar%a(:,i)
psi(i) = pole * (- f_vf (one, vp, psi(i)) + m * psi(i))
psipsibarp%a(:,i) = psi(i)%a
end do
end function pr_dyadleft
@
\begin{equation}
\sum_n \psi_n\otimes\bar\psi_n \frac{i(\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma}
\end{equation}
<<(Not used yet) Implementation of spinor propagators>>=
pure function pr_dyadright (p, m, w, psipsibar) result (psipsibarp)
type(spinordyad) :: psipsibarp
type(momentum), intent(in) :: p
real(kind=default), intent(in) :: m, w
type(spinordyad), intent(in) :: psipsibar
integer :: i
type(vector) :: vp
type(conjspinor), dimension(4) :: psibar
complex(kind=default) :: pole
complex(kind=default), parameter :: one = (1, 0)
vp = p
pole = 1 / cmplx (p*p - m**2, m*w, kind=default)
do i = 1, 4
psibar(i)%a = psipsibar%a(i,:)
psibar(i) = pole * (f_fv (one, psibar(i), vp) + m * psibar(i))
psipsibarp%a(i,:) = psibar(i)%a
end do
end function pr_dyadright
@
\section{Spinor Couplings Revisited}
<<[[omega_bispinor_couplings.f90]]>>=
<<Copyleft>>
module omega_bispinor_couplings
use kinds
use constants
use omega_bispinors
use omega_vectorspinors
use omega_vectors
use omega_couplings
implicit none
private
<<Declaration of bispinor on shell wave functions>>
<<Declaration of bispinor off shell wave functions>>
<<Declaration of bispinor currents>>
<<Declaration of bispinor propagators>>
integer, parameter, public :: omega_bispinor_cpls_2010_01_A = 0
contains
<<Implementation of bispinor on shell wave functions>>
<<Implementation of bispinor off shell wave functions>>
<<Implementation of bispinor currents>>
<<Implementation of bispinor propagators>>
end module omega_bispinor_couplings
@
See table~\ref{tab:fermionic-currents} for the names of Fortran
functions. We could have used long names instead, but this would
increase the chance of running past continuation line limits without
adding much to the legibility.
@
\subsection{Fermionic Vector and Axial Couplings}
There's more than one chiral representation. This one is compatible
with HELAS~\cite{HELAS}.
\begin{subequations}
\begin{align}
& \gamma^0 = \begin{pmatrix} 0 & \mathbf{1} \\ \mathbf{1} & 0
\end{pmatrix},\;
\gamma^i = \begin{pmatrix} 0 & \sigma^i \\ -\sigma^i & 0 \end{pmatrix},\;
\gamma_5 = i\gamma^0\gamma^1\gamma^2\gamma^3
= \begin{pmatrix} -\mathbf{1} & 0 \\ 0 & \mathbf{1}
\end{pmatrix}, \\ &
C = \begin{pmatrix} \epsilon & 0 \\ 0 & - \epsilon \end{pmatrix}
\; , \qquad \epsilon = \begin{pmatrix} 0 & 1 \\ -1 & 0 \end{pmatrix} .
\end{align}
\end{subequations}
Therefore
\begin{subequations}
\begin{align}
g_S + g_P\gamma_5 &=
\begin{pmatrix}
g_S - g_P & 0 & 0 & 0 \\
0 & g_S - g_P & 0 & 0 \\
0 & 0 & g_S + g_P & 0 \\
0 & 0 & 0 & g_S + g_P
\end{pmatrix} \\
g_V\gamma^0 - g_A\gamma^0\gamma_5 &=
\begin{pmatrix}
0 & 0 & g_V - g_A & 0 \\
0 & 0 & 0 & g_V - g_A \\
g_V + g_A & 0 & 0 & 0 \\
0 & g_V + g_A & 0 & 0
\end{pmatrix} \\
g_V\gamma^1 - g_A\gamma^1\gamma_5 &=
\begin{pmatrix}
0 & 0 & 0 & g_V - g_A \\
0 & 0 & g_V - g_A & 0 \\
0 & - g_V - g_A & 0 & 0 \\
- g_V - g_A & 0 & 0 & 0
\end{pmatrix} \\
g_V\gamma^2 - g_A\gamma^2\gamma_5 &=
\begin{pmatrix}
0 & 0 & 0 & -\ii(g_V - g_A) \\
0 & 0 & \ii(g_V - g_A) & 0 \\
0 & \ii(g_V + g_A) & 0 & 0 \\
-\ii(g_V + g_A) & 0 & 0 & 0
\end{pmatrix} \\
g_V\gamma^3 - g_A\gamma^3\gamma_5 &=
\begin{pmatrix}
0 & 0 & g_V - g_A & 0 \\
0 & 0 & 0 & - g_V + g_A \\
- g_V - g_A & 0 & 0 & 0 \\
0 & g_V + g_A & 0 & 0
\end{pmatrix}
\end{align}
\end{subequations}
and
\begin{subequations}
\begin{align}
C(g_S + g_P\gamma_5) &=
\begin{pmatrix}
0 & g_S - g_P & 0 & 0 \\
- g_S + g_P & 0 & 0 & 0 \\
0 & 0 & 0 & - g_S - g_P \\
0 & 0 & g_S + g_P & 0
\end{pmatrix} \\
C(g_V\gamma^0 - g_A\gamma^0\gamma_5) &=
\begin{pmatrix}
0 & 0 & 0 & g_V - g_A \\
0 & 0 & - g_V + g_A & 0 \\
0 & - g_V - g_A & 0 & 0 \\
g_V + g_A & 0 & 0 & 0
\end{pmatrix} \\
C(g_V\gamma^1 - g_A\gamma^1\gamma_5) &=
\begin{pmatrix}
0 & 0 & g_V - g_A & 0 \\
0 & 0 & 0 & - g_V + g_A \\
g_V + g_A & 0 & 0 & 0 \\
0 & - g_V - g_A & 0 & 0
\end{pmatrix} \\
C(g_V\gamma^2 - g_A\gamma^2\gamma_5) &=
\begin{pmatrix}
0 & 0 & \ii(g_V - g_A) & 0 \\
0 & 0 & 0 & \ii(g_V - g_A) \\
\ii(g_V + g_A) & 0 & 0 & 0 \\
0 & \ii(g_V + g_A) & 0 & 0
\end{pmatrix} \\
C(g_V\gamma^3 - g_A\gamma^3\gamma_5) &=
\begin{pmatrix}
0 & 0 & 0 & - g_V + g_A \\
0 & 0 & - g_V + g_A & 0 \\
0 & - g_V - g_A & 0 & 0 \\
- g_V - g_A & 0 & 0 & 0
\end{pmatrix}
\end{align}
\end{subequations}
<<Declaration of bispinor currents>>=
public :: va_ff, v_ff, a_ff, vl_ff, vr_ff, vlr_ff, va2_ff
@
<<Implementation of bispinor currents>>=
pure function va_ff (gv, ga, psil, psir) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: gv, ga
type(bispinor), intent(in) :: psil, psir
complex(kind=default) :: gl, gr
complex(kind=default) :: g13, g14, g23, g24, g31, g32, g41, g42
gl = gv + ga
gr = gv - ga
g13 = psil%a(1)*psir%a(3)
g14 = psil%a(1)*psir%a(4)
g23 = psil%a(2)*psir%a(3)
g24 = psil%a(2)*psir%a(4)
g31 = psil%a(3)*psir%a(1)
g32 = psil%a(3)*psir%a(2)
g41 = psil%a(4)*psir%a(1)
g42 = psil%a(4)*psir%a(2)
j%t = gr * ( g14 - g23) + gl * ( - g32 + g41)
j%x(1) = gr * ( g13 - g24) + gl * ( g31 - g42)
j%x(2) = (gr * ( g13 + g24) + gl * ( g31 + g42)) * (0, 1)
j%x(3) = gr * ( - g14 - g23) + gl * ( - g32 - g41)
end function va_ff
@
<<Implementation of bispinor currents>>=
pure function va2_ff (gva, psil, psir) result (j)
type(vector) :: j
complex(kind=default), intent(in), dimension(2) :: gva
type(bispinor), intent(in) :: psil, psir
complex(kind=default) :: gl, gr
complex(kind=default) :: g13, g14, g23, g24, g31, g32, g41, g42
gl = gva(1) + gva(2)
gr = gva(1) - gva(2)
g13 = psil%a(1)*psir%a(3)
g14 = psil%a(1)*psir%a(4)
g23 = psil%a(2)*psir%a(3)
g24 = psil%a(2)*psir%a(4)
g31 = psil%a(3)*psir%a(1)
g32 = psil%a(3)*psir%a(2)
g41 = psil%a(4)*psir%a(1)
g42 = psil%a(4)*psir%a(2)
j%t = gr * ( g14 - g23) + gl * ( - g32 + g41)
j%x(1) = gr * ( g13 - g24) + gl * ( g31 - g42)
j%x(2) = (gr * ( g13 + g24) + gl * ( g31 + g42)) * (0, 1)
j%x(3) = gr * ( - g14 - g23) + gl * ( - g32 - g41)
end function va2_ff
@
<<Implementation of bispinor currents>>=
pure function v_ff (gv, psil, psir) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: gv
type(bispinor), intent(in) :: psil, psir
complex(kind=default) :: g13, g14, g23, g24, g31, g32, g41, g42
g13 = psil%a(1)*psir%a(3)
g14 = psil%a(1)*psir%a(4)
g23 = psil%a(2)*psir%a(3)
g24 = psil%a(2)*psir%a(4)
g31 = psil%a(3)*psir%a(1)
g32 = psil%a(3)*psir%a(2)
g41 = psil%a(4)*psir%a(1)
g42 = psil%a(4)*psir%a(2)
j%t = gv * ( g14 - g23 - g32 + g41)
j%x(1) = gv * ( g13 - g24 + g31 - g42)
j%x(2) = gv * ( g13 + g24 + g31 + g42) * (0, 1)
j%x(3) = gv * ( - g14 - g23 - g32 - g41)
end function v_ff
@
<<Implementation of bispinor currents>>=
pure function a_ff (ga, psil, psir) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: ga
type(bispinor), intent(in) :: psil, psir
complex(kind=default) :: g13, g14, g23, g24, g31, g32, g41, g42
g13 = psil%a(1)*psir%a(3)
g14 = psil%a(1)*psir%a(4)
g23 = psil%a(2)*psir%a(3)
g24 = psil%a(2)*psir%a(4)
g31 = psil%a(3)*psir%a(1)
g32 = psil%a(3)*psir%a(2)
g41 = psil%a(4)*psir%a(1)
g42 = psil%a(4)*psir%a(2)
j%t = -ga * ( g14 - g23 + g32 - g41)
j%x(1) = -ga * ( g13 - g24 - g31 + g42)
j%x(2) = -ga * ( g13 + g24 - g31 - g42) * (0, 1)
j%x(3) = -ga * ( - g14 - g23 + g32 + g41)
end function a_ff
@
<<Implementation of bispinor currents>>=
pure function vl_ff (gl, psil, psir) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: gl
type(bispinor), intent(in) :: psil, psir
complex(kind=default) :: gl2
complex(kind=default) :: g31, g32, g41, g42
gl2 = 2 * gl
g31 = psil%a(3)*psir%a(1)
g32 = psil%a(3)*psir%a(2)
g41 = psil%a(4)*psir%a(1)
g42 = psil%a(4)*psir%a(2)
j%t = gl2 * ( - g32 + g41)
j%x(1) = gl2 * ( g31 - g42)
j%x(2) = gl2 * ( g31 + g42) * (0, 1)
j%x(3) = gl2 * ( - g32 - g41)
end function vl_ff
@
<<Implementation of bispinor currents>>=
pure function vr_ff (gr, psil, psir) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: gr
type(bispinor), intent(in) :: psil, psir
complex(kind=default) :: gr2
complex(kind=default) :: g13, g14, g23, g24
gr2 = 2 * gr
g13 = psil%a(1)*psir%a(3)
g14 = psil%a(1)*psir%a(4)
g23 = psil%a(2)*psir%a(3)
g24 = psil%a(2)*psir%a(4)
j%t = gr2 * ( g14 - g23)
j%x(1) = gr2 * ( g13 - g24)
j%x(2) = gr2 * ( g13 + g24) * (0, 1)
j%x(3) = gr2 * ( - g14 - g23)
end function vr_ff
@
<<Implementation of bispinor currents>>=
pure function vlr_ff (gl, gr, psibar, psi) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: gl, gr
type(bispinor), intent(in) :: psibar
type(bispinor), intent(in) :: psi
j = va_ff (gl+gr, gl-gr, psibar, psi)
end function vlr_ff
@
and
\begin{equation}
\fmslash{v} - \fmslash{a}\gamma_5 =
\begin{pmatrix}
0 & 0 & v_- - a_- & - v^* + a^* \\
0 & 0 & - v + a & v_+ - a_+ \\
v_+ + a_+ & v^* + a^* & 0 & 0 \\
v + a & v_- + a_- & 0 & 0
\end{pmatrix}
\end{equation}
with $v_\pm=v_0\pm v_3$, $a_\pm=a_0\pm a_3$, $v=v_1+\ii v_2$,
$v^*=v_1-\ii v_2$, $a=a_1+\ii a_2$, and $a^*=a_1-\ii a_2$. But note
that~$\cdot^*$ is \emph{not} complex conjugation for complex~$v_\mu$
or~$a_\mu$.
<<Declaration of bispinor currents>>=
public :: f_vaf, f_vf, f_af, f_vlf, f_vrf, f_vlrf, f_va2f
@
<<Implementation of bispinor currents>>=
pure function f_vaf (gv, ga, v, psi) result (vpsi)
type(bispinor) :: vpsi
complex(kind=default), intent(in) :: gv, ga
type(vector), intent(in) :: v
type(bispinor), intent(in) :: psi
complex(kind=default) :: gl, gr
complex(kind=default) :: vp, vm, v12, v12s
gl = gv + ga
gr = gv - ga
vp = v%t + v%x(3)
vm = v%t - v%x(3)
v12 = v%x(1) + (0,1)*v%x(2)
v12s = v%x(1) - (0,1)*v%x(2)
vpsi%a(1) = gr * ( vm * psi%a(3) - v12s * psi%a(4))
vpsi%a(2) = gr * ( - v12 * psi%a(3) + vp * psi%a(4))
vpsi%a(3) = gl * ( vp * psi%a(1) + v12s * psi%a(2))
vpsi%a(4) = gl * ( v12 * psi%a(1) + vm * psi%a(2))
end function f_vaf
@
<<Implementation of bispinor currents>>=
pure function f_va2f (gva, v, psi) result (vpsi)
type(bispinor) :: vpsi
complex(kind=default), intent(in), dimension(2) :: gva
type(vector), intent(in) :: v
type(bispinor), intent(in) :: psi
complex(kind=default) :: gl, gr
complex(kind=default) :: vp, vm, v12, v12s
gl = gva(1) + gva(2)
gr = gva(1) - gva(2)
vp = v%t + v%x(3)
vm = v%t - v%x(3)
v12 = v%x(1) + (0,1)*v%x(2)
v12s = v%x(1) - (0,1)*v%x(2)
vpsi%a(1) = gr * ( vm * psi%a(3) - v12s * psi%a(4))
vpsi%a(2) = gr * ( - v12 * psi%a(3) + vp * psi%a(4))
vpsi%a(3) = gl * ( vp * psi%a(1) + v12s * psi%a(2))
vpsi%a(4) = gl * ( v12 * psi%a(1) + vm * psi%a(2))
end function f_va2f
@
<<Implementation of bispinor currents>>=
pure function f_vf (gv, v, psi) result (vpsi)
type(bispinor) :: vpsi
complex(kind=default), intent(in) :: gv
type(vector), intent(in) :: v
type(bispinor), intent(in) :: psi
complex(kind=default) :: vp, vm, v12, v12s
vp = v%t + v%x(3)
vm = v%t - v%x(3)
v12 = v%x(1) + (0,1)*v%x(2)
v12s = v%x(1) - (0,1)*v%x(2)
vpsi%a(1) = gv * ( vm * psi%a(3) - v12s * psi%a(4))
vpsi%a(2) = gv * ( - v12 * psi%a(3) + vp * psi%a(4))
vpsi%a(3) = gv * ( vp * psi%a(1) + v12s * psi%a(2))
vpsi%a(4) = gv * ( v12 * psi%a(1) + vm * psi%a(2))
end function f_vf
@
<<Implementation of bispinor currents>>=
pure function f_af (ga, v, psi) result (vpsi)
type(bispinor) :: vpsi
complex(kind=default), intent(in) :: ga
type(vector), intent(in) :: v
type(bispinor), intent(in) :: psi
complex(kind=default) :: vp, vm, v12, v12s
vp = v%t + v%x(3)
vm = v%t - v%x(3)
v12 = v%x(1) + (0,1)*v%x(2)
v12s = v%x(1) - (0,1)*v%x(2)
vpsi%a(1) = ga * ( - vm * psi%a(3) + v12s * psi%a(4))
vpsi%a(2) = ga * ( v12 * psi%a(3) - vp * psi%a(4))
vpsi%a(3) = ga * ( vp * psi%a(1) + v12s * psi%a(2))
vpsi%a(4) = ga * ( v12 * psi%a(1) + vm * psi%a(2))
end function f_af
@
<<Implementation of bispinor currents>>=
pure function f_vlf (gl, v, psi) result (vpsi)
type(bispinor) :: vpsi
complex(kind=default), intent(in) :: gl
type(vector), intent(in) :: v
type(bispinor), intent(in) :: psi
complex(kind=default) :: gl2
complex(kind=default) :: vp, vm, v12, v12s
gl2 = 2 * gl
vp = v%t + v%x(3)
vm = v%t - v%x(3)
v12 = v%x(1) + (0,1)*v%x(2)
v12s = v%x(1) - (0,1)*v%x(2)
vpsi%a(1) = 0
vpsi%a(2) = 0
vpsi%a(3) = gl2 * ( vp * psi%a(1) + v12s * psi%a(2))
vpsi%a(4) = gl2 * ( v12 * psi%a(1) + vm * psi%a(2))
end function f_vlf
@
<<Implementation of bispinor currents>>=
pure function f_vrf (gr, v, psi) result (vpsi)
type(bispinor) :: vpsi
complex(kind=default), intent(in) :: gr
type(vector), intent(in) :: v
type(bispinor), intent(in) :: psi
complex(kind=default) :: gr2
complex(kind=default) :: vp, vm, v12, v12s
gr2 = 2 * gr
vp = v%t + v%x(3)
vm = v%t - v%x(3)
v12 = v%x(1) + (0,1)*v%x(2)
v12s = v%x(1) - (0,1)*v%x(2)
vpsi%a(1) = gr2 * ( vm * psi%a(3) - v12s * psi%a(4))
vpsi%a(2) = gr2 * ( - v12 * psi%a(3) + vp * psi%a(4))
vpsi%a(3) = 0
vpsi%a(4) = 0
end function f_vrf
@
<<Implementation of bispinor currents>>=
pure function f_vlrf (gl, gr, v, psi) result (vpsi)
type(bispinor) :: vpsi
complex(kind=default), intent(in) :: gl, gr
type(vector), intent(in) :: v
type(bispinor), intent(in) :: psi
vpsi = f_vaf (gl+gr, gl-gr, v, psi)
end function f_vlrf
@ \subsection{Fermionic Scalar and Pseudo Scalar Couplings}
<<Declaration of bispinor currents>>=
public :: sp_ff, s_ff, p_ff, sl_ff, sr_ff, slr_ff
@
<<Implementation of bispinor currents>>=
pure function sp_ff (gs, gp, psil, psir) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: gs, gp
type(bispinor), intent(in) :: psil, psir
j = (gs - gp) * (psil%a(1)*psir%a(2) - psil%a(2)*psir%a(1)) &
+ (gs + gp) * (- psil%a(3)*psir%a(4) + psil%a(4)*psir%a(3))
end function sp_ff
@
<<Implementation of bispinor currents>>=
pure function s_ff (gs, psil, psir) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: gs
type(bispinor), intent(in) :: psil, psir
j = gs * (psil * psir)
end function s_ff
@
<<Implementation of bispinor currents>>=
pure function p_ff (gp, psil, psir) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: gp
type(bispinor), intent(in) :: psil, psir
j = gp * (- psil%a(1)*psir%a(2) + psil%a(2)*psir%a(1) &
- psil%a(3)*psir%a(4) + psil%a(4)*psir%a(3))
end function p_ff
@
<<Implementation of bispinor currents>>=
pure function sl_ff (gl, psil, psir) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: gl
type(bispinor), intent(in) :: psil, psir
j = 2 * gl * (psil%a(1)*psir%a(2) - psil%a(2)*psir%a(1))
end function sl_ff
@
<<Implementation of bispinor currents>>=
pure function sr_ff (gr, psil, psir) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: gr
type(bispinor), intent(in) :: psil, psir
j = 2 * gr * (- psil%a(3)*psir%a(4) + psil%a(4)*psir%a(3))
end function sr_ff
@
<<Implementation of bispinor currents>>=
pure function slr_ff (gl, gr, psibar, psi) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: gl, gr
type(bispinor), intent(in) :: psibar
type(bispinor), intent(in) :: psi
j = sp_ff (gr+gl, gr-gl, psibar, psi)
end function slr_ff
@
<<Declaration of bispinor currents>>=
public :: f_spf, f_sf, f_pf, f_slf, f_srf, f_slrf
@
<<Implementation of bispinor currents>>=
pure function f_spf (gs, gp, phi, psi) result (phipsi)
type(bispinor) :: phipsi
complex(kind=default), intent(in) :: gs, gp
complex(kind=default), intent(in) :: phi
type(bispinor), intent(in) :: psi
phipsi%a(1:2) = ((gs - gp) * phi) * psi%a(1:2)
phipsi%a(3:4) = ((gs + gp) * phi) * psi%a(3:4)
end function f_spf
@
<<Implementation of bispinor currents>>=
pure function f_sf (gs, phi, psi) result (phipsi)
type(bispinor) :: phipsi
complex(kind=default), intent(in) :: gs
complex(kind=default), intent(in) :: phi
type(bispinor), intent(in) :: psi
phipsi%a = (gs * phi) * psi%a
end function f_sf
@
<<Implementation of bispinor currents>>=
pure function f_pf (gp, phi, psi) result (phipsi)
type(bispinor) :: phipsi
complex(kind=default), intent(in) :: gp
complex(kind=default), intent(in) :: phi
type(bispinor), intent(in) :: psi
phipsi%a(1:2) = (- gp * phi) * psi%a(1:2)
phipsi%a(3:4) = ( gp * phi) * psi%a(3:4)
end function f_pf
@
<<Implementation of bispinor currents>>=
pure function f_slf (gl, phi, psi) result (phipsi)
type(bispinor) :: phipsi
complex(kind=default), intent(in) :: gl
complex(kind=default), intent(in) :: phi
type(bispinor), intent(in) :: psi
phipsi%a(1:2) = (2 * gl * phi) * psi%a(1:2)
phipsi%a(3:4) = 0
end function f_slf
@
<<Implementation of bispinor currents>>=
pure function f_srf (gr, phi, psi) result (phipsi)
type(bispinor) :: phipsi
complex(kind=default), intent(in) :: gr
complex(kind=default), intent(in) :: phi
type(bispinor), intent(in) :: psi
phipsi%a(1:2) = 0
phipsi%a(3:4) = (2 * gr * phi) * psi%a(3:4)
end function f_srf
@
<<Implementation of bispinor currents>>=
pure function f_slrf (gl, gr, phi, psi) result (phipsi)
type(bispinor) :: phipsi
complex(kind=default), intent(in) :: gl, gr
complex(kind=default), intent(in) :: phi
type(bispinor), intent(in) :: psi
phipsi = f_spf (gr+gl, gr-gl, phi, psi)
end function f_slrf
@ \subsection{Couplings for BRST Transformations}
\subsubsection{3-Couplings}
The lists of needed gamma matrices can be found in the next subsection with
the gravitino couplings.
<<Declaration of bispinor currents>>=
private :: vv_ff, f_vvf
@
<<Declaration of bispinor currents>>=
public :: vmom_ff, mom_ff, mom5_ff, moml_ff, momr_ff, lmom_ff, rmom_ff
@
<<Implementation of bispinor currents>>=
pure function vv_ff (psibar, psi, k) result (psibarpsi)
type(vector) :: psibarpsi
type(bispinor), intent(in) :: psibar, psi
type(vector), intent(in) :: k
complex(kind=default) :: kp, km, k12, k12s
type(bispinor) :: kgpsi1, kgpsi2, kgpsi3, kgpsi4
kp = k%t + k%x(3)
km = k%t - k%x(3)
k12 = k%x(1) + (0,1)*k%x(2)
k12s = k%x(1) - (0,1)*k%x(2)
kgpsi1%a(1) = -k%x(3) * psi%a(1) - k12s * psi%a(2)
kgpsi1%a(2) = -k12 * psi%a(1) + k%x(3) * psi%a(2)
kgpsi1%a(3) = k%x(3) * psi%a(3) + k12s * psi%a(4)
kgpsi1%a(4) = k12 * psi%a(3) - k%x(3) * psi%a(4)
kgpsi2%a(1) = ((0,-1) * k%x(2)) * psi%a(1) - km * psi%a(2)
kgpsi2%a(2) = - kp * psi%a(1) + ((0,1) * k%x(2)) * psi%a(2)
kgpsi2%a(3) = ((0,-1) * k%x(2)) * psi%a(3) + kp * psi%a(4)
kgpsi2%a(4) = km * psi%a(3) + ((0,1) * k%x(2)) * psi%a(4)
kgpsi3%a(1) = (0,1) * (k%x(1) * psi%a(1) + km * psi%a(2))
kgpsi3%a(2) = (0,-1) * (kp * psi%a(1) + k%x(1) * psi%a(2))
kgpsi3%a(3) = (0,1) * (k%x(1) * psi%a(3) - kp * psi%a(4))
kgpsi3%a(4) = (0,1) * (km * psi%a(3) - k%x(1) * psi%a(4))
kgpsi4%a(1) = -k%t * psi%a(1) - k12s * psi%a(2)
kgpsi4%a(2) = k12 * psi%a(1) + k%t * psi%a(2)
kgpsi4%a(3) = k%t * psi%a(3) - k12s * psi%a(4)
kgpsi4%a(4) = k12 * psi%a(3) - k%t * psi%a(4)
psibarpsi%t = 2 * (psibar * kgpsi1)
psibarpsi%x(1) = 2 * (psibar * kgpsi2)
psibarpsi%x(2) = 2 * (psibar * kgpsi3)
psibarpsi%x(3) = 2 * (psibar * kgpsi4)
end function vv_ff
@
<<Implementation of bispinor currents>>=
pure function f_vvf (v, psi, k) result (kvpsi)
type(bispinor) :: kvpsi
type(bispinor), intent(in) :: psi
type(vector), intent(in) :: k, v
complex(kind=default) :: kv30, kv21, kv01, kv31, kv02, kv32
complex(kind=default) :: ap, am, bp, bm, bps, bms
kv30 = k%x(3) * v%t - k%t * v%x(3)
kv21 = (0,1) * (k%x(2) * v%x(1) - k%x(1) * v%x(2))
kv01 = k%t * v%x(1) - k%x(1) * v%t
kv31 = k%x(3) * v%x(1) - k%x(1) * v%x(3)
kv02 = (0,1) * (k%t * v%x(2) - k%x(2) * v%t)
kv32 = (0,1) * (k%x(3) * v%x(2) - k%x(2) * v%x(3))
ap = 2 * (kv30 + kv21)
am = 2 * (-kv30 + kv21)
bp = 2 * (kv01 + kv31 + kv02 + kv32)
bm = 2 * (kv01 - kv31 + kv02 - kv32)
bps = 2 * (kv01 + kv31 - kv02 - kv32)
bms = 2 * (kv01 - kv31 - kv02 + kv32)
kvpsi%a(1) = am * psi%a(1) + bms * psi%a(2)
kvpsi%a(2) = bp * psi%a(1) - am * psi%a(2)
kvpsi%a(3) = ap * psi%a(3) - bps * psi%a(4)
kvpsi%a(4) = -bm * psi%a(3) - ap * psi%a(4)
end function f_vvf
@
<<Implementation of bispinor currents>>=
pure function vmom_ff (g, psibar, psi, k) result (psibarpsi)
type(vector) :: psibarpsi
complex(kind=default), intent(in) :: g
type(bispinor), intent(in) :: psibar, psi
type(momentum), intent(in) :: k
type(vector) :: vk
vk = k
psibarpsi = g * vv_ff (psibar, psi, vk)
end function vmom_ff
@
<<Implementation of bispinor currents>>=
pure function mom_ff (g, m, psibar, psi, k) result (psibarpsi)
complex(kind=default) :: psibarpsi
type(bispinor), intent(in) :: psibar, psi
type(momentum), intent(in) :: k
complex(kind=default), intent(in) :: g, m
type(bispinor) :: kmpsi
complex(kind=default) :: kp, km, k12, k12s
kp = k%t + k%x(3)
km = k%t - k%x(3)
k12 = k%x(1) + (0,1)*k%x(2)
k12s = k%x(1) - (0,1)*k%x(2)
kmpsi%a(1) = km * psi%a(3) - k12s * psi%a(4)
kmpsi%a(2) = kp * psi%a(4) - k12 * psi%a(3)
kmpsi%a(3) = kp * psi%a(1) + k12s * psi%a(2)
kmpsi%a(4) = k12 * psi%a(1) + km * psi%a(2)
psibarpsi = g * (psibar * kmpsi) + s_ff (m, psibar, psi)
end function mom_ff
@
<<Implementation of bispinor currents>>=
pure function mom5_ff (g, m, psibar, psi, k) result (psibarpsi)
complex(kind=default) :: psibarpsi
type(bispinor), intent(in) :: psibar, psi
type(momentum), intent(in) :: k
complex(kind=default), intent(in) :: g, m
type(bispinor) :: g5psi
g5psi%a(1:2) = - psi%a(1:2)
g5psi%a(3:4) = psi%a(3:4)
psibarpsi = mom_ff (g, m, psibar, g5psi, k)
end function mom5_ff
@
<<Implementation of bispinor currents>>=
pure function moml_ff (g, m, psibar, psi, k) result (psibarpsi)
complex(kind=default) :: psibarpsi
type(bispinor), intent(in) :: psibar, psi
type(momentum), intent(in) :: k
complex(kind=default), intent(in) :: g, m
type(bispinor) :: leftpsi
leftpsi%a(1:2) = 2 * psi%a(1:2)
leftpsi%a(3:4) = 0
psibarpsi = mom_ff (g, m, psibar, leftpsi, k)
end function moml_ff
@
<<Implementation of bispinor currents>>=
pure function momr_ff (g, m, psibar, psi, k) result (psibarpsi)
complex(kind=default) :: psibarpsi
type(bispinor), intent(in) :: psibar, psi
type(momentum), intent(in) :: k
complex(kind=default), intent(in) :: g, m
type(bispinor) :: rightpsi
rightpsi%a(1:2) = 0
rightpsi%a(3:4) = 2 * psi%a(3:4)
psibarpsi = mom_ff (g, m, psibar, rightpsi, k)
end function momr_ff
@
<<Implementation of bispinor currents>>=
pure function lmom_ff (g, m, psibar, psi, k) result (psibarpsi)
complex(kind=default) :: psibarpsi
type(bispinor), intent(in) :: psibar, psi
type(momentum), intent(in) :: k
complex(kind=default), intent(in) :: g, m
psibarpsi = mom_ff (g, m, psibar, psi, k) + &
mom5_ff (g,-m, psibar, psi, k)
end function lmom_ff
@
<<Implementation of bispinor currents>>=
pure function rmom_ff (g, m, psibar, psi, k) result (psibarpsi)
complex(kind=default) :: psibarpsi
type(bispinor), intent(in) :: psibar, psi
type(momentum), intent(in) :: k
complex(kind=default), intent(in) :: g, m
psibarpsi = mom_ff (g, m, psibar, psi, k) - &
mom5_ff (g,-m, psibar, psi, k)
end function rmom_ff
@
<<Declaration of bispinor currents>>=
public :: f_vmomf, f_momf, f_mom5f, f_momlf, f_momrf, f_lmomf, f_rmomf
@
<<Implementation of bispinor currents>>=
pure function f_vmomf (g, v, psi, k) result (kvpsi)
type(bispinor) :: kvpsi
type(bispinor), intent(in) :: psi
complex(kind=default), intent(in) :: g
type(momentum), intent(in) :: k
type(vector), intent(in) :: v
type(vector) :: vk
vk = k
kvpsi = g * f_vvf (v, psi, vk)
end function f_vmomf
@
<<Implementation of bispinor currents>>=
pure function f_momf (g, m, phi, psi, k) result (kmpsi)
type(bispinor) :: kmpsi
type(bispinor), intent(in) :: psi
complex(kind=default), intent(in) :: phi, g, m
type(momentum), intent(in) :: k
complex(kind=default) :: kp, km, k12, k12s
kp = k%t + k%x(3)
km = k%t - k%x(3)
k12 = k%x(1) + (0,1)*k%x(2)
k12s = k%x(1) - (0,1)*k%x(2)
kmpsi%a(1) = km * psi%a(3) - k12s * psi%a(4)
kmpsi%a(2) = -k12 * psi%a(3) + kp * psi%a(4)
kmpsi%a(3) = kp * psi%a(1) + k12s * psi%a(2)
kmpsi%a(4) = k12 * psi%a(1) + km * psi%a(2)
kmpsi = g * (phi * kmpsi) + f_sf (m, phi, psi)
end function f_momf
@
<<Implementation of bispinor currents>>=
pure function f_mom5f (g, m, phi, psi, k) result (kmpsi)
type(bispinor) :: kmpsi
type(bispinor), intent(in) :: psi
complex(kind=default), intent(in) :: phi, g, m
type(momentum), intent(in) :: k
type(bispinor) :: g5psi
g5psi%a(1:2) = - psi%a(1:2)
g5psi%a(3:4) = psi%a(3:4)
kmpsi = f_momf (g, m, phi, g5psi, k)
end function f_mom5f
@
<<Implementation of bispinor currents>>=
pure function f_momlf (g, m, phi, psi, k) result (kmpsi)
type(bispinor) :: kmpsi
type(bispinor), intent(in) :: psi
complex(kind=default), intent(in) :: phi, g, m
type(momentum), intent(in) :: k
type(bispinor) :: leftpsi
leftpsi%a(1:2) = 2 * psi%a(1:2)
leftpsi%a(3:4) = 0
kmpsi = f_momf (g, m, phi, leftpsi, k)
end function f_momlf
@
<<Implementation of bispinor currents>>=
pure function f_momrf (g, m, phi, psi, k) result (kmpsi)
type(bispinor) :: kmpsi
type(bispinor), intent(in) :: psi
complex(kind=default), intent(in) :: phi, g, m
type(momentum), intent(in) :: k
type(bispinor) :: rightpsi
rightpsi%a(1:2) = 0
rightpsi%a(3:4) = 2 * psi%a(3:4)
kmpsi = f_momf (g, m, phi, rightpsi, k)
end function f_momrf
@
<<Implementation of bispinor currents>>=
pure function f_lmomf (g, m, phi, psi, k) result (kmpsi)
type(bispinor) :: kmpsi
type(bispinor), intent(in) :: psi
complex(kind=default), intent(in) :: phi, g, m
type(momentum), intent(in) :: k
kmpsi = f_momf (g, m, phi, psi, k) + &
f_mom5f (g,-m, phi, psi, k)
end function f_lmomf
@
<<Implementation of bispinor currents>>=
pure function f_rmomf (g, m, phi, psi, k) result (kmpsi)
type(bispinor) :: kmpsi
type(bispinor), intent(in) :: psi
complex(kind=default), intent(in) :: phi, g, m
type(momentum), intent(in) :: k
kmpsi = f_momf (g, m, phi, psi, k) - &
f_mom5f (g,-m, phi, psi, k)
end function f_rmomf
@
\subsubsection{4-Couplings}
<<Declaration of bispinor currents>>=
public :: v2_ff, sv1_ff, sv2_ff, pv1_ff, pv2_ff, svl1_ff, svl2_ff, &
svr1_ff, svr2_ff, svlr1_ff, svlr2_ff
@
<<Implementation of bispinor currents>>=
pure function v2_ff (g, psibar, v, psi) result (v2)
type(vector) :: v2
complex (kind=default), intent(in) :: g
type(bispinor), intent(in) :: psibar, psi
type(vector), intent(in) :: v
v2 = (-g) * vv_ff (psibar, psi, v)
end function v2_ff
@
<<Implementation of bispinor currents>>=
pure function sv1_ff (g, psibar, v, psi) result (phi)
complex(kind=default) :: phi
type(bispinor), intent(in) :: psibar, psi
type(vector), intent(in) :: v
complex(kind=default), intent(in) :: g
phi = psibar * f_vf (g, v, psi)
end function sv1_ff
@
<<Implementation of bispinor currents>>=
pure function sv2_ff (g, psibar, phi, psi) result (v)
type(vector) :: v
complex(kind=default), intent(in) :: phi, g
type(bispinor), intent(in) :: psibar, psi
v = phi * v_ff (g, psibar, psi)
end function sv2_ff
@
<<Implementation of bispinor currents>>=
pure function pv1_ff (g, psibar, v, psi) result (phi)
complex(kind=default) :: phi
type(bispinor), intent(in) :: psibar, psi
type(vector), intent(in) :: v
complex(kind=default), intent(in) :: g
phi = - (psibar * f_af (g, v, psi))
end function pv1_ff
@
<<Implementation of bispinor currents>>=
pure function pv2_ff (g, psibar, phi, psi) result (v)
type(vector) :: v
complex(kind=default), intent(in) :: phi, g
type(bispinor), intent(in) :: psibar, psi
v = -(phi * a_ff (g, psibar, psi))
end function pv2_ff
@
<<Implementation of bispinor currents>>=
pure function svl1_ff (g, psibar, v, psi) result (phi)
complex(kind=default) :: phi
type(bispinor), intent(in) :: psibar, psi
type(vector), intent(in) :: v
complex(kind=default), intent(in) :: g
phi = psibar * f_vlf (g, v, psi)
end function svl1_ff
@
<<Implementation of bispinor currents>>=
pure function svl2_ff (g, psibar, phi, psi) result (v)
type(vector) :: v
complex(kind=default), intent(in) :: phi, g
type(bispinor), intent(in) :: psibar, psi
v = phi * vl_ff (g, psibar, psi)
end function svl2_ff
@
<<Implementation of bispinor currents>>=
pure function svr1_ff (g, psibar, v, psi) result (phi)
complex(kind=default) :: phi
type(bispinor), intent(in) :: psibar, psi
type(vector), intent(in) :: v
complex(kind=default), intent(in) :: g
phi = psibar * f_vrf (g, v, psi)
end function svr1_ff
@
<<Implementation of bispinor currents>>=
pure function svr2_ff (g, psibar, phi, psi) result (v)
type(vector) :: v
complex(kind=default), intent(in) :: phi, g
type(bispinor), intent(in) :: psibar, psi
v = phi * vr_ff (g, psibar, psi)
end function svr2_ff
@
<<Implementation of bispinor currents>>=
pure function svlr1_ff (gl, gr, psibar, v, psi) result (phi)
complex(kind=default) :: phi
type(bispinor), intent(in) :: psibar, psi
type(vector), intent(in) :: v
complex(kind=default), intent(in) :: gl, gr
phi = psibar * f_vlrf (gl, gr, v, psi)
end function svlr1_ff
@
<<Implementation of bispinor currents>>=
pure function svlr2_ff (gl, gr, psibar, phi, psi) result (v)
type(vector) :: v
complex(kind=default), intent(in) :: phi, gl, gr
type(bispinor), intent(in) :: psibar, psi
v = phi * vlr_ff (gl, gr, psibar, psi)
end function svlr2_ff
@
<<Declaration of bispinor currents>>=
public :: f_v2f, f_svf, f_pvf, f_svlf, f_svrf, f_svlrf
@
<<Implementation of bispinor currents>>=
pure function f_v2f (g, v1, v2, psi) result (vpsi)
type(bispinor) :: vpsi
complex(kind=default), intent(in) :: g
type(bispinor), intent(in) :: psi
type(vector), intent(in) :: v1, v2
vpsi = g * f_vvf (v2, psi, v1)
end function f_v2f
@
<<Implementation of bispinor currents>>=
pure function f_svf (g, phi, v, psi) result (pvpsi)
type(bispinor) :: pvpsi
complex(kind=default), intent(in) :: g, phi
type(bispinor), intent(in) :: psi
type(vector), intent(in) :: v
pvpsi = phi * f_vf (g, v, psi)
end function f_svf
@
<<Implementation of bispinor currents>>=
pure function f_pvf (g, phi, v, psi) result (pvpsi)
type(bispinor) :: pvpsi
complex(kind=default), intent(in) :: g, phi
type(bispinor), intent(in) :: psi
type(vector), intent(in) :: v
pvpsi = -(phi * f_af (g, v, psi))
end function f_pvf
@
<<Implementation of bispinor currents>>=
pure function f_svlf (g, phi, v, psi) result (pvpsi)
type(bispinor) :: pvpsi
complex(kind=default), intent(in) :: g, phi
type(bispinor), intent(in) :: psi
type(vector), intent(in) :: v
pvpsi = phi * f_vlf (g, v, psi)
end function f_svlf
@
<<Implementation of bispinor currents>>=
pure function f_svrf (g, phi, v, psi) result (pvpsi)
type(bispinor) :: pvpsi
complex(kind=default), intent(in) :: g, phi
type(bispinor), intent(in) :: psi
type(vector), intent(in) :: v
pvpsi = phi * f_vrf (g, v, psi)
end function f_svrf
@
<<Implementation of bispinor currents>>=
pure function f_svlrf (gl, gr, phi, v, psi) result (pvpsi)
type(bispinor) :: pvpsi
complex(kind=default), intent(in) :: gl, gr, phi
type(bispinor), intent(in) :: psi
type(vector), intent(in) :: v
pvpsi = phi * f_vlrf (gl, gr, v, psi)
end function f_svlrf
@ \subsection{Gravitino Couplings}
<<Declaration of bispinor currents>>=
public :: pot_grf, pot_fgr, s_grf, s_fgr, p_grf, p_fgr, &
sl_grf, sl_fgr, sr_grf, sr_fgr, slr_grf, slr_fgr
@
<<Declaration of bispinor currents>>=
private :: fgvgr, fgvg5gr, fggvvgr, grkgf, grkggf, grkkggf, &
fgkgr, fg5gkgr, grvgf, grg5vgf, grkgggf, fggkggr
@
<<Implementation of bispinor currents>>=
pure function pot_grf (g, gravbar, psi) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: g
type(vectorspinor), intent(in) :: gravbar
type(bispinor), intent(in) :: psi
type(vectorspinor) :: gamma_psi
gamma_psi%psi(1)%a(1) = psi%a(3)
gamma_psi%psi(1)%a(2) = psi%a(4)
gamma_psi%psi(1)%a(3) = psi%a(1)
gamma_psi%psi(1)%a(4) = psi%a(2)
gamma_psi%psi(2)%a(1) = psi%a(4)
gamma_psi%psi(2)%a(2) = psi%a(3)
gamma_psi%psi(2)%a(3) = - psi%a(2)
gamma_psi%psi(2)%a(4) = - psi%a(1)
gamma_psi%psi(3)%a(1) = (0,-1) * psi%a(4)
gamma_psi%psi(3)%a(2) = (0,1) * psi%a(3)
gamma_psi%psi(3)%a(3) = (0,1) * psi%a(2)
gamma_psi%psi(3)%a(4) = (0,-1) * psi%a(1)
gamma_psi%psi(4)%a(1) = psi%a(3)
gamma_psi%psi(4)%a(2) = - psi%a(4)
gamma_psi%psi(4)%a(3) = - psi%a(1)
gamma_psi%psi(4)%a(4) = psi%a(2)
j = g * (gravbar * gamma_psi)
end function pot_grf
@
<<Implementation of bispinor currents>>=
pure function pot_fgr (g, psibar, grav) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: g
type(bispinor), intent(in) :: psibar
type(vectorspinor), intent(in) :: grav
type(bispinor) :: gamma_grav
gamma_grav%a(1) = grav%psi(1)%a(3) - grav%psi(2)%a(4) + &
((0,1)*grav%psi(3)%a(4)) - grav%psi(4)%a(3)
gamma_grav%a(2) = grav%psi(1)%a(4) - grav%psi(2)%a(3) - &
((0,1)*grav%psi(3)%a(3)) + grav%psi(4)%a(4)
gamma_grav%a(3) = grav%psi(1)%a(1) + grav%psi(2)%a(2) - &
((0,1)*grav%psi(3)%a(2)) + grav%psi(4)%a(1)
gamma_grav%a(4) = grav%psi(1)%a(2) + grav%psi(2)%a(1) + &
((0,1)*grav%psi(3)%a(1)) - grav%psi(4)%a(2)
j = g * (psibar * gamma_grav)
end function pot_fgr
@
<<Implementation of bispinor currents>>=
pure function grvgf (gravbar, psi, k) result (j)
complex(kind=default) :: j
complex(kind=default) :: kp, km, k12, k12s
type(vectorspinor), intent(in) :: gravbar
type(bispinor), intent(in) :: psi
type(vector), intent(in) :: k
type(vectorspinor) :: kg_psi
kp = k%t + k%x(3)
km = k%t - k%x(3)
k12 = k%x(1) + (0,1)*k%x(2)
k12s = k%x(1) - (0,1)*k%x(2)
!!! Since we are taking the spinor product here, NO explicit
!!! charge conjugation matrix is needed!
kg_psi%psi(1)%a(1) = km * psi%a(1) - k12s * psi%a(2)
kg_psi%psi(1)%a(2) = (-k12) * psi%a(1) + kp * psi%a(2)
kg_psi%psi(1)%a(3) = kp * psi%a(3) + k12s * psi%a(4)
kg_psi%psi(1)%a(4) = k12 * psi%a(3) + km * psi%a(4)
kg_psi%psi(2)%a(1) = k12s * psi%a(1) - km * psi%a(2)
kg_psi%psi(2)%a(2) = (-kp) * psi%a(1) + k12 * psi%a(2)
kg_psi%psi(2)%a(3) = k12s * psi%a(3) + kp * psi%a(4)
kg_psi%psi(2)%a(4) = km * psi%a(3) + k12 * psi%a(4)
kg_psi%psi(3)%a(1) = (0,1) * (k12s * psi%a(1) + km * psi%a(2))
kg_psi%psi(3)%a(2) = (0,1) * (- kp * psi%a(1) - k12 * psi%a(2))
kg_psi%psi(3)%a(3) = (0,1) * (k12s * psi%a(3) - kp * psi%a(4))
kg_psi%psi(3)%a(4) = (0,1) * (km * psi%a(3) - k12 * psi%a(4))
kg_psi%psi(4)%a(1) = (-km) * psi%a(1) - k12s * psi%a(2)
kg_psi%psi(4)%a(2) = k12 * psi%a(1) + kp * psi%a(2)
kg_psi%psi(4)%a(3) = kp * psi%a(3) - k12s * psi%a(4)
kg_psi%psi(4)%a(4) = k12 * psi%a(3) - km * psi%a(4)
j = gravbar * kg_psi
end function grvgf
@
<<Implementation of bispinor currents>>=
pure function grg5vgf (gravbar, psi, k) result (j)
complex(kind=default) :: j
type(vectorspinor), intent(in) :: gravbar
type(bispinor), intent(in) :: psi
type(vector), intent(in) :: k
type(bispinor) :: g5_psi
g5_psi%a(1:2) = - psi%a(1:2)
g5_psi%a(3:4) = psi%a(3:4)
j = grvgf (gravbar, g5_psi, k)
end function grg5vgf
@
<<Implementation of bispinor currents>>=
pure function s_grf (g, gravbar, psi, k) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: g
type(vectorspinor), intent(in) :: gravbar
type(bispinor), intent(in) :: psi
type(momentum), intent(in) :: k
type(vector) :: vk
vk = k
j = g * grvgf (gravbar, psi, vk)
end function s_grf
@
<<Implementation of bispinor currents>>=
pure function sl_grf (gl, gravbar, psi, k) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: gl
type(vectorspinor), intent(in) :: gravbar
type(bispinor), intent(in) :: psi
type(bispinor) :: psi_l
type(momentum), intent(in) :: k
psi_l%a(1:2) = psi%a(1:2)
psi_l%a(3:4) = 0
j = s_grf (gl, gravbar, psi_l, k)
end function sl_grf
@
<<Implementation of bispinor currents>>=
pure function sr_grf (gr, gravbar, psi, k) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: gr
type(vectorspinor), intent(in) :: gravbar
type(bispinor), intent(in) :: psi
type(bispinor) :: psi_r
type(momentum), intent(in) :: k
psi_r%a(1:2) = 0
psi_r%a(3:4) = psi%a(3:4)
j = s_grf (gr, gravbar, psi_r, k)
end function sr_grf
@
<<Implementation of bispinor currents>>=
pure function slr_grf (gl, gr, gravbar, psi, k) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: gl, gr
type(vectorspinor), intent(in) :: gravbar
type(bispinor), intent(in) :: psi
type(momentum), intent(in) :: k
j = sl_grf (gl, gravbar, psi, k) + sr_grf (gr, gravbar, psi, k)
end function slr_grf
@
<<Implementation of bispinor currents>>=
pure function fgkgr (psibar, grav, k) result (j)
complex(kind=default) :: j
complex(kind=default) :: kp, km, k12, k12s
type(bispinor), intent(in) :: psibar
type(vectorspinor), intent(in) :: grav
type(vector), intent(in) :: k
type(bispinor) :: gk_grav
kp = k%t + k%x(3)
km = k%t - k%x(3)
k12 = k%x(1) + (0,1)*k%x(2)
k12s = k%x(1) - (0,1)*k%x(2)
!!! Since we are taking the spinor product here, NO explicit
!!! charge conjugation matrix is needed!
gk_grav%a(1) = kp * grav%psi(1)%a(1) + k12s * grav%psi(1)%a(2) &
- k12 * grav%psi(2)%a(1) - km * grav%psi(2)%a(2) &
+ (0,1) * k12 * grav%psi(3)%a(1) &
+ (0,1) * km * grav%psi(3)%a(2) &
- kp * grav%psi(4)%a(1) - k12s * grav%psi(4)%a(2)
gk_grav%a(2) = k12 * grav%psi(1)%a(1) + km * grav%psi(1)%a(2) &
- kp * grav%psi(2)%a(1) - k12s * grav%psi(2)%a(2) &
- (0,1) * kp * grav%psi(3)%a(1) &
- (0,1) * k12s * grav%psi(3)%a(2) &
+ k12 * grav%psi(4)%a(1) + km * grav%psi(4)%a(2)
gk_grav%a(3) = km * grav%psi(1)%a(3) - k12s * grav%psi(1)%a(4) &
- k12 * grav%psi(2)%a(3) + kp * grav%psi(2)%a(4) &
+ (0,1) * k12 * grav%psi(3)%a(3) &
- (0,1) * kp * grav%psi(3)%a(4) &
+ km * grav%psi(4)%a(3) - k12s * grav%psi(4)%a(4)
gk_grav%a(4) = - k12 * grav%psi(1)%a(3) + kp * grav%psi(1)%a(4) &
+ km * grav%psi(2)%a(3) - k12s * grav%psi(2)%a(4) &
+ (0,1) * km * grav%psi(3)%a(3) &
- (0,1) * k12s * grav%psi(3)%a(4) &
+ k12 * grav%psi(4)%a(3) - kp * grav%psi(4)%a(4)
j = psibar * gk_grav
end function fgkgr
@
<<Implementation of bispinor currents>>=
pure function fg5gkgr (psibar, grav, k) result (j)
complex(kind=default) :: j
type(bispinor), intent(in) :: psibar
type(vectorspinor), intent(in) :: grav
type(vector), intent(in) :: k
type(bispinor) :: psibar_g5
psibar_g5%a(1:2) = - psibar%a(1:2)
psibar_g5%a(3:4) = psibar%a(3:4)
j = fgkgr (psibar_g5, grav, k)
end function fg5gkgr
@
<<Implementation of bispinor currents>>=
pure function s_fgr (g, psibar, grav, k) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: g
type(bispinor), intent(in) :: psibar
type(vectorspinor), intent(in) :: grav
type(momentum), intent(in) :: k
type(vector) :: vk
vk = k
j = g * fgkgr (psibar, grav, vk)
end function s_fgr
@
<<Implementation of bispinor currents>>=
pure function sl_fgr (gl, psibar, grav, k) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: gl
type(bispinor), intent(in) :: psibar
type(bispinor) :: psibar_l
type(vectorspinor), intent(in) :: grav
type(momentum), intent(in) :: k
psibar_l%a(1:2) = psibar%a(1:2)
psibar_l%a(3:4) = 0
j = s_fgr (gl, psibar_l, grav, k)
end function sl_fgr
@
<<Implementation of bispinor currents>>=
pure function sr_fgr (gr, psibar, grav, k) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: gr
type(bispinor), intent(in) :: psibar
type(bispinor) :: psibar_r
type(vectorspinor), intent(in) :: grav
type(momentum), intent(in) :: k
psibar_r%a(1:2) = 0
psibar_r%a(3:4) = psibar%a(3:4)
j = s_fgr (gr, psibar_r, grav, k)
end function sr_fgr
@
@
<<Implementation of bispinor currents>>=
pure function slr_fgr (gl, gr, psibar, grav, k) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: gl, gr
type(bispinor), intent(in) :: psibar
type(bispinor) :: psibar_r
type(vectorspinor), intent(in) :: grav
type(momentum), intent(in) :: k
j = sl_fgr (gl, psibar, grav, k) + sr_fgr (gr, psibar, grav, k)
end function slr_fgr
@
<<Implementation of bispinor currents>>=
pure function p_grf (g, gravbar, psi, k) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: g
type(vectorspinor), intent(in) :: gravbar
type(bispinor), intent(in) :: psi
type(momentum), intent(in) :: k
type(vector) :: vk
vk = k
j = g * grg5vgf (gravbar, psi, vk)
end function p_grf
@
<<Implementation of bispinor currents>>=
pure function p_fgr (g, psibar, grav, k) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: g
type(bispinor), intent(in) :: psibar
type(vectorspinor), intent(in) :: grav
type(momentum), intent(in) :: k
type(vector) :: vk
vk = k
j = g * fg5gkgr (psibar, grav, vk)
end function p_fgr
@
<<Declaration of bispinor currents>>=
public :: f_potgr, f_sgr, f_pgr, f_vgr, f_vlrgr, f_slgr, f_srgr, f_slrgr
@
<<Implementation of bispinor currents>>=
pure function f_potgr (g, phi, psi) result (phipsi)
type(bispinor) :: phipsi
complex(kind=default), intent(in) :: g
complex(kind=default), intent(in) :: phi
type(vectorspinor), intent(in) :: psi
phipsi%a(1) = (g * phi) * (psi%psi(1)%a(3) - psi%psi(2)%a(4) + &
((0,1)*psi%psi(3)%a(4)) - psi%psi(4)%a(3))
phipsi%a(2) = (g * phi) * (psi%psi(1)%a(4) - psi%psi(2)%a(3) - &
((0,1)*psi%psi(3)%a(3)) + psi%psi(4)%a(4))
phipsi%a(3) = (g * phi) * (psi%psi(1)%a(1) + psi%psi(2)%a(2) - &
((0,1)*psi%psi(3)%a(2)) + psi%psi(4)%a(1))
phipsi%a(4) = (g * phi) * (psi%psi(1)%a(2) + psi%psi(2)%a(1) + &
((0,1)*psi%psi(3)%a(1)) - psi%psi(4)%a(2))
end function f_potgr
@
The slashed notation:
\begin{equation}
\fmslash{k} =
\begin{pmatrix}
0 & 0 & k_- & - k^* \\
0 & 0 & - k & k_+ \\
k_+ & k^* & 0 & 0 \\
k & k_- & 0 & 0
\end{pmatrix} , \qquad
\fmslash{k}\gamma_5 =
\begin{pmatrix}
0 & 0 & k_- & - k^* \\
0 & 0 & - k & k_+ \\
- k_+ & - k^* & 0 & 0 \\
- k & - k_- & 0 & 0 \end{pmatrix}
\end{equation}
with $k_\pm=k_0\pm k_3$, $k=k_1+\ii k_2$,
$k^*=k_1-\ii k_2$. But note that~$\cdot^*$ is \emph{not} complex
conjugation for complex~$k_\mu$.
\begin{subequations}
\begin{alignat}{2}
\gamma^0 \fmslash{k} &=
\begin{pmatrix}
k_+ & k^* & 0 & 0 \\
k & k_- & 0 & 0 \\
0 & 0 & k_- & - k^* \\
0 & 0 & - k & k_+
\end{pmatrix} , & \qquad
\gamma^0 \fmslash{k} \gamma^5 & =
\begin{pmatrix}
- k_+ & - k^* & 0 & 0 \\
- k & - k_- & 0 & 0 \\
0 & 0 & k_- & - k^* \\
0 & 0 & - k & k_+
\end{pmatrix} \\
\gamma^1 \fmslash{k} &=
\begin{pmatrix}
k & k_- & 0 & 0 \\
k_+ & k^* & 0 & 0 \\
0 & 0 & k & - k_+ \\
0 & 0 & - k_- & k^*
\end{pmatrix}, & \qquad
\gamma^1 \fmslash{k} \gamma^5 & =
\begin{pmatrix}
- k & - k_- & 0 & 0 \\
- k_+ & - k^* & 0 & 0 \\
0 & 0 & k & - k_+ \\
0 & 0 & - k_- & k^*
\end{pmatrix} \\
\gamma^2 \fmslash{k} &=
\begin{pmatrix}
- \ii k & - \ii k_- & 0 & 0 \\
\ii k_+ & \ii k^* & 0 & 0 \\
0 & 0 & - \ii k & \ii k_+ \\
0 & 0 & - \ii k_- & \ii k^*
\end{pmatrix}, & \qquad
\gamma^2 \fmslash{k} \gamma^5 & =
\begin{pmatrix}
\ii k & \ii k_- & 0 & 0 \\
- \ii k_+ & - \ii k^* & 0 & 0 \\
0 & 0 & - \ii k & \ii k_+ \\
0 & 0 & - \ii k_- & \ii k^*
\end{pmatrix} \\
\gamma^3 \fmslash{k} &=
\begin{pmatrix}
k_+ & k^* & 0 & 0 \\
- k & - k_- & 0 & 0 \\
0 & 0 & - k_- & k^* \\
0 & 0 & - k & k_+
\end{pmatrix}, & \qquad
\gamma^3 \fmslash{k} \gamma^5 & =
\begin{pmatrix}
- k_+ & - k^* & 0 & 0 \\
k & k_- & 0 & 0 \\
0 & 0 & - k_- & k^* \\
0 & 0 & - k & k_+
\end{pmatrix}
\end{alignat}
\end{subequations}
and
\begin{subequations}
\begin{alignat}{2}
\fmslash{k} \gamma^0&=
\begin{pmatrix}
k_- & - k^* & 0 & 0 \\
- k & k_+ & 0 & 0 \\
0 & 0 & k_+ & k^* \\
0 & 0 & k & k_-
\end{pmatrix} , & \qquad
\fmslash{k} \gamma^0 \gamma^5 & =
\begin{pmatrix}
- k_- & k^* & 0 & 0 \\
k & - k_+ & 0 & 0 \\
0 & 0 & k_+ & k^* \\
0 & 0 & k & k_-
\end{pmatrix} \\
\fmslash{k} \gamma^1 &=
\begin{pmatrix}
k^* & - k_- & 0 & 0 \\
- k_+ & k & 0 & 0 \\
0 & 0 & k^* & k_+ \\
0 & 0 & k_- & k
\end{pmatrix}, & \qquad
\fmslash{k} \gamma^1 \gamma^5 & =
\begin{pmatrix}
- k^* & k_- & 0 & 0 \\
k_+ & - k & 0 & 0 \\
0 & 0 & k^* & k_+ \\
0 & 0 & k_- & k
\end{pmatrix} \\
\fmslash{k} \gamma^2 &=
\begin{pmatrix}
\ii k^* & \ii k_- & 0 & 0 \\
- \ii k_+ & - \ii k & 0 & 0 \\
0 & 0 & \ii k^* & - \ii k_+ \\
0 & 0 & \ii k_- & - \ii k
\end{pmatrix}, & \qquad
\fmslash{k} \gamma^2 \gamma^5 & =
\begin{pmatrix}
- \ii k^* & - \ii k_- & 0 & 0 \\
\ii k_+ & \ii k & 0 & 0 \\
0 & 0 & \ii k^* & - \ii k_+ \\
0 & 0 & \ii k_- & - \ii k
\end{pmatrix} \\
\fmslash{k} \gamma^3 &=
\begin{pmatrix}
- k_- & - k^* & 0 & 0 \\
k & k_+ & 0 & 0 \\
0 & 0 & k_+ & - k^* \\
0 & 0 & k & - k_-
\end{pmatrix}, & \qquad
\fmslash{k} \gamma^3 \gamma^5 & =
\begin{pmatrix}
k_- & k^* & 0 & 0 \\
- k & - k_+ & 0 & 0 \\
0 & 0 & k_+ & - k^* \\
0 & 0 & k & - k_-
\end{pmatrix}
\end{alignat}
\end{subequations}
and
\begin{subequations}
\begin{alignat}{2}
C \gamma^0 \fmslash{k} &=
\begin{pmatrix}
k & k_- & 0 & 0 \\
- k_+ & - k^* & 0 & 0 \\
0 & 0 & k & - k_+ \\
0 & 0 & k_- & - k^*
\end{pmatrix} , & \qquad
C \gamma^0 \fmslash{k} \gamma^5 & =
\begin{pmatrix}
- k & - k_- & 0 & 0 \\
k_+ & k^* & 0 & 0 \\
0 & 0 & k & - k_+ \\
0 & 0 & k_- & - k^*
\end{pmatrix} \\
C \gamma^1 \fmslash{k} &=
\begin{pmatrix}
k_+ & k^* & 0 & 0 \\
- k & - k_- & 0 & 0 \\
0 & 0 & k_- & - k^* \\
0 & 0 & k & - k_+
\end{pmatrix}, & \qquad
C \gamma^1 \fmslash{k} \gamma^5 & =
\begin{pmatrix}
- k_+ & - k^* & 0 & 0 \\
k & k_- & 0 & 0 \\
0 & 0 & k_- & - k^* \\
0 & 0 & k & - k_+
\end{pmatrix} \\
C \gamma^2 \fmslash{k} &=
\begin{pmatrix}
\ii k_+ & \ii k^* & 0 & 0 \\
\ii k & \ii k_- & 0 & 0 \\
0 & 0 & \ii k_- & - \ii k^* \\
0 & 0 & - \ii k & \ii k_+
\end{pmatrix}, & \qquad
C \gamma^2 \fmslash{k} \gamma^5 & =
\begin{pmatrix}
- \ii k_+ & - \ii k^* & 0 & 0 \\
- \ii k & - \ii k_- & 0 & 0 \\
0 & 0 & \ii k_- & - \ii k^* \\
0 & 0 & - \ii k & \ii k_+
\end{pmatrix} \\
C \gamma^3 \fmslash{k} &=
\begin{pmatrix}
- k & - k_- & 0 & 0 \\
- k_+ & - k^* & 0 & 0 \\
0 & 0 & k & - k_+ \\
0 & 0 & - k_- & k^*
\end{pmatrix}, & \qquad
C \gamma^3 \fmslash{k} \gamma^5 & =
\begin{pmatrix}
k & k_- & 0 & 0 \\
k_+ & k^* & 0 & 0 \\
0 & 0 & k & - k_+ \\
0 & 0 & - k_- & k^*
\end{pmatrix}
\end{alignat}
\end{subequations}
and
\begin{subequations}
\begin{alignat}{2}
C \fmslash{k} \gamma^0&=
\begin{pmatrix}
- k & k^+ & 0 & 0 \\
- k_- & k^* & 0 & 0 \\
0 & 0 & - k & - k_- \\
0 & 0 & k_+ & k^*
\end{pmatrix} , & \qquad
C \fmslash{k} \gamma^0 \gamma^5 & =
\begin{pmatrix}
k & - k_+ & 0 & 0 \\
k_- & - k^* & 0 & 0 \\
0 & 0 & - k & - k_- \\
0 & 0 & k_+ & k^*
\end{pmatrix} \\
C \fmslash{k} \gamma^1 &=
\begin{pmatrix}
- k_+ & k & 0 & 0 \\
- k^* & k_- & 0 & 0 \\
0 & 0 & - k_- & - k \\
0 & 0 & k^* & k_+
\end{pmatrix}, & \qquad
C \fmslash{k} \gamma^1 \gamma^5 & =
\begin{pmatrix}
k_+ & - k & 0 & 0 \\
k^* & - k_- & 0 & 0 \\
0 & 0 & - k_- & - k \\
0 & 0 & k^* & k_+
\end{pmatrix} \\
C \fmslash{k} \gamma^2 &=
\begin{pmatrix}
- \ii k_+ & - \ii k & 0 & 0 \\
- \ii k^* & - \ii k_- & 0 & 0 \\
0 & 0 & - \ii k_- & \ii k \\
0 & 0 & \ii k^* & - \ii k_+
\end{pmatrix}, & \qquad
C \fmslash{k} \gamma^2 \gamma^5 & =
\begin{pmatrix}
\ii k_+ & \ii k & 0 & 0 \\
\ii k^* & \ii k_- & 0 & 0 \\
0 & 0 & - \ii k_- & \ii k \\
0 & 0 & \ii k^* & - \ii k_+
\end{pmatrix} \\
C \fmslash{k} \gamma^3 &=
\begin{pmatrix}
k & k_+ & 0 & 0 \\
k_- & k^* & 0 & 0 \\
0 & 0 & - k & k_- \\
0 & 0 & k_+ & - k^*
\end{pmatrix}, & \qquad
C \fmslash{k} \gamma^3 \gamma^5 & =
\begin{pmatrix}
- k & - k_+ & 0 & 0 \\
- k_- & - k^* & 0 & 0 \\
0 & 0 & - k & k_- \\
0 & 0 & k_+ & - k^*
\end{pmatrix}
\end{alignat}
\end{subequations}
<<Implementation of bispinor currents>>=
pure function fgvgr (psi, k) result (kpsi)
type(bispinor) :: kpsi
complex(kind=default) :: kp, km, k12, k12s
type(vector), intent(in) :: k
type(vectorspinor), intent(in) :: psi
kp = k%t + k%x(3)
km = k%t - k%x(3)
k12 = k%x(1) + (0,1)*k%x(2)
k12s = k%x(1) - (0,1)*k%x(2)
kpsi%a(1) = kp * psi%psi(1)%a(1) + k12s * psi%psi(1)%a(2) &
- k12 * psi%psi(2)%a(1) - km * psi%psi(2)%a(2) &
+ (0,1) * k12 * psi%psi(3)%a(1) + (0,1) * km * psi%psi(3)%a(2) &
- kp * psi%psi(4)%a(1) - k12s * psi%psi(4)%a(2)
kpsi%a(2) = k12 * psi%psi(1)%a(1) + km * psi%psi(1)%a(2) &
- kp * psi%psi(2)%a(1) - k12s * psi%psi(2)%a(2) &
- (0,1) * kp * psi%psi(3)%a(1) - (0,1) * k12s * psi%psi(3)%a(2) &
+ k12 * psi%psi(4)%a(1) + km * psi%psi(4)%a(2)
kpsi%a(3) = km * psi%psi(1)%a(3) - k12s * psi%psi(1)%a(4) &
- k12 * psi%psi(2)%a(3) + kp * psi%psi(2)%a(4) &
+ (0,1) * k12 * psi%psi(3)%a(3) - (0,1) * kp * psi%psi(3)%a(4) &
+ km * psi%psi(4)%a(3) - k12s * psi%psi(4)%a(4)
kpsi%a(4) = - k12 * psi%psi(1)%a(3) + kp * psi%psi(1)%a(4) &
+ km * psi%psi(2)%a(3) - k12s * psi%psi(2)%a(4) &
+ (0,1) * km * psi%psi(3)%a(3) - (0,1) * k12s * psi%psi(3)%a(4) &
+ k12 * psi%psi(4)%a(3) - kp * psi%psi(4)%a(4)
end function fgvgr
@
<<Implementation of bispinor currents>>=
pure function f_sgr (g, phi, psi, k) result (phipsi)
type(bispinor) :: phipsi
complex(kind=default), intent(in) :: g
complex(kind=default), intent(in) :: phi
type(momentum), intent(in) :: k
type(vectorspinor), intent(in) :: psi
type(vector) :: vk
vk = k
phipsi = (g * phi) * fgvgr (psi, vk)
end function f_sgr
@
<<Implementation of bispinor currents>>=
pure function f_slgr (gl, phi, psi, k) result (phipsi)
type(bispinor) :: phipsi
complex(kind=default), intent(in) :: gl
complex(kind=default), intent(in) :: phi
type(momentum), intent(in) :: k
type(vectorspinor), intent(in) :: psi
phipsi = f_sgr (gl, phi, psi, k)
phipsi%a(3:4) = 0
end function f_slgr
@
<<Implementation of bispinor currents>>=
pure function f_srgr (gr, phi, psi, k) result (phipsi)
type(bispinor) :: phipsi
complex(kind=default), intent(in) :: gr
complex(kind=default), intent(in) :: phi
type(momentum), intent(in) :: k
type(vectorspinor), intent(in) :: psi
phipsi = f_sgr (gr, phi, psi, k)
phipsi%a(1:2) = 0
end function f_srgr
@
<<Implementation of bispinor currents>>=
pure function f_slrgr (gl, gr, phi, psi, k) result (phipsi)
type(bispinor) :: phipsi, phipsi_l, phipsi_r
complex(kind=default), intent(in) :: gl, gr
complex(kind=default), intent(in) :: phi
type(momentum), intent(in) :: k
type(vectorspinor), intent(in) :: psi
phipsi_l = f_slgr (gl, phi, psi, k)
phipsi_r = f_srgr (gr, phi, psi, k)
phipsi%a(1:2) = phipsi_l%a(1:2)
phipsi%a(3:4) = phipsi_r%a(3:4)
end function f_slrgr
@
<<Implementation of bispinor currents>>=
pure function fgvg5gr (psi, k) result (kpsi)
type(bispinor) :: kpsi
type(vector), intent(in) :: k
type(vectorspinor), intent(in) :: psi
type(bispinor) :: kpsi_dum
kpsi_dum = fgvgr (psi, k)
kpsi%a(1:2) = - kpsi_dum%a(1:2)
kpsi%a(3:4) = kpsi_dum%a(3:4)
end function fgvg5gr
@
<<Implementation of bispinor currents>>=
pure function f_pgr (g, phi, psi, k) result (phipsi)
type(bispinor) :: phipsi
complex(kind=default), intent(in) :: g
complex(kind=default), intent(in) :: phi
type(momentum), intent(in) :: k
type(vectorspinor), intent(in) :: psi
type(vector) :: vk
vk = k
phipsi = (g * phi) * fgvg5gr (psi, vk)
end function f_pgr
@
The needed construction of gamma matrices involving the commutator
of two gamma matrices. For the slashed terms we use as usual the
abbreviations $k_\pm=k_0\pm k_3$, $k=k_1+\ii k_2$, $k^*=k_1-\ii k_2$
and analogous expressions for the vector $v^\mu$. We remind you
that~$\cdot^*$ is \emph{not} complex conjugation for complex~$k_\mu$.
Furthermore we introduce (in what follows the brackets around the vector
indices have the usual meaning of antisymmetrizing with respect to the
indices inside the brackets, here without a factor two in the denominator)
\begin{subequations}
\begin{alignat}{2}
a_+ &= \; k_+ v_- + k v^* - k_- v_+ - k^* v & \; = &
\; 2 (k_{[3} v_{0]} + \ii k_{[2} v_{1]}) \\
a_- &= \; k_- v_+ + k v^* - k_+ v_- - k^* v & \; = &
\; 2 (-k_{[3} v_{0]} + \ii k_{[2} v_{1]}) \\
b_+ &= \; 2 (k_+ v - k v_+) & \; = &
\; 2 (k_{[0} v_{1]} + k_{[3} v_{1]} + \ii k_{[0} v_{2]} + \ii
k_{[3} v_{2]}) \\
b_- &= \; 2 (k_- v - k v_-) & \; = &
\; 2 (k_{[0} v_{1]} - k_{[3} v_{1]} + \ii k_{[0} v_{2]} - \ii
k_{[3} v_{2]}) \\
b_{+*} &= \; 2 (k_+ v^* - k^* v_+) & \; = &
\; 2 (k_{[0} v_{1]} + k_{[3} v_{1]} - \ii k_{[0} v_{2]} - \ii
k_{[3} v_{2]}) \\
b_{-*} &= \; 2 (k_- v^* - k^* v_-) & \; = &
\; 2 (k_{[0} v_{1]} - k_{[3} v_{1]} - \ii k_{[0} v_{2]} + \ii
k_{[3} v_{2]})
\end{alignat}
\end{subequations}
Of course, one could introduce a more advanced notation, but we don't want to
become confused.
\begin{subequations}
\begin{align}
\lbrack \fmslash{k} , \gamma^0 \rbrack &=
\begin{pmatrix}
-2k_3 & -2 k^* & 0 & 0 \\
-2k & 2k_3 & 0 & 0 \\
0 & 0 & 2k_3 & 2k^* \\
0 & 0 & 2k & -2k_3
\end{pmatrix} \\
\lbrack \fmslash{k} , \gamma^1 \rbrack &=
\begin{pmatrix}
-2\ii k_2 & -2k_- & 0 & 0 \\
-2k_+ & 2\ii k_2 & 0 & 0 \\
0 & 0 & -2\ii k_2 & 2k_+ \\
0 & 0 & 2k_- & 2\ii k_2
\end{pmatrix} \\
\lbrack \fmslash{k} , \gamma^2 \rbrack &=
\begin{pmatrix}
2\ii k_1 & 2\ii k_- & 0 & 0 \\
-2\ii k_+ & -2\ii k_1 & 0 & 0 \\
0 & 0 & 2\ii k_1 & -2\ii k_+ \\
0 & 0 & 2\ii k_- & -2\ii k_1
\end{pmatrix} \\
\lbrack \fmslash{k} , \gamma^3 \rbrack &=
\begin{pmatrix}
-2k_0 & -2k^* & 0 & 0 \\
2k & 2k_0 & 0 & 0 \\
0 & 0 & 2k_0 & -2k^* \\
0 & 0 & 2k & -2k_0
\end{pmatrix} \\
\lbrack \fmslash{k} , \fmslash{V} \rbrack &=
\begin{pmatrix}
a_- & b_{-*} & 0 & 0 \\
b_+ & -a_- & 0 & 0 \\
0 & 0 & a_+ & -b_{+*} \\
0 & 0 & -b_- & -a_+
\end{pmatrix} \\
\gamma^5\gamma^0 \lbrack \fmslash{k} , \fmslash{V} \rbrack &=
\begin{pmatrix}
0 & 0 & - a_+ & b_{+*} \\
0 & 0 & b_- & a_+ \\
a_- & b_{-*} & 0 & 0 \\
b_+ & - a_- & 0 & 0
\end{pmatrix} \\
\gamma^5\gamma^1 \lbrack \fmslash{k} , \fmslash{V} \rbrack &=
\begin{pmatrix}
0 & 0 & b_- & a_+ \\
0 & 0 & -a_+ & b_{+*} \\
-b_+ & a_- & 0 & 0 & \\
-a_- & -b_{-*} & 0 & 0
\end{pmatrix} \\
\gamma^5\gamma^2 \lbrack \fmslash{k} , \fmslash{V} \rbrack &=
\begin{pmatrix}
0 & 0 & -\ii b_- & -\ii a_+ \\
0 & 0 & -\ii a_+ & \ii b_{+*} \\
\ii b_+ & -\ii a_- & 0 & 0 \\
-\ii a_- & -\ii b_{-*} & 0 & 0
\end{pmatrix} \\
\gamma^5\gamma^3 \lbrack \fmslash{k} , \fmslash{V} \rbrack &=
\begin{pmatrix}
0 & 0 & -a_+ & b_{+*} \\
0 & 0 & -b_- & -a_+ \\
-a_- & -b_{-*} & 0 & 0 \\
b_+ & -a_- & 0 & 0
\end{pmatrix}
\end{align}
\end{subequations}
and
\begin{subequations}
\begin{align}
\lbrack \fmslash{k} , \fmslash{V} \rbrack \gamma^0 \gamma^5 &=
\begin{pmatrix}
0 & 0 & a_- & b_{-*} \\
0 & 0 & b_+ & -a_- \\
-a_+ & b_{+*} & 0 & 0 \\
b_- & a_+ & 0 & 0
\end{pmatrix} \\
\lbrack \fmslash{k} , \fmslash{V} \rbrack \gamma^1 \gamma^5 &=
\begin{pmatrix}
0 & 0 & b_{-*} & a_- \\
0 & 0 & -a_- & b_+ \\
-b_{+*} & a_+ & 0 & 0 \\
-a_+ & -b_- & 0 & 0
\end{pmatrix} \\
\lbrack \fmslash{k} , \fmslash{V} \rbrack \gamma^2 \gamma^5 &=
\begin{pmatrix}
0 & 0 & \ii b_{-*} & -\ii a_- \\
0 & 0 & -\ii a_- & -\ii b_+ \\
-\ii b_{+*} & -\ii a_+ & 0 & 0 \\
-\ii a_+ & \ii b_- & 0 & 0
\end{pmatrix} \\
\lbrack \fmslash{k} , \fmslash{V} \rbrack \gamma^3 \gamma^5 &=
\begin{pmatrix}
0 & 0 & a_- & - b_{-*} \\
0 & 0 & b_+ & a_- \\
a_+ & b_{+*} & 0 & 0 \\
-b_- & a_+ & 0 & 0
\end{pmatrix}
\end{align}
\end{subequations}
In what follows $l$ always means twice the value of $k$, e.g. $l_+$ =
$2 k_+$. We use the abbreviation $C^{\mu\nu} \equiv C \lbrack
\fmslash{k}, \gamma^\mu \rbrack \gamma^\nu \gamma^5$.
\begin{subequations}
\begin{alignat}{2}
C^{00} &= \begin{pmatrix}
0 & 0 & -l & -l_3 \\ 0 & 0 & l_3 & l^* \\
l & -l_3 & 0 & 0 \\ -l_3 & -l^* & 0 & 0 \end{pmatrix} , & \qquad
C^{20} &= \begin{pmatrix}
0 & 0 & -\ii l_+ & -\ii l_1 \\ 0 & 0 & -\ii l_1 & -\ii l_- \\
\ii l_- & -\ii l_1 & 0 & 0 \\ -\ii l_1 & \ii l_+ & 0 & 0
\end{pmatrix} \\
C^{01} &= \begin{pmatrix}
0 & 0 & l_3 & -l \\ 0 & 0 & l^* & l_3 \\
l_3 & -l & 0 & 0 \\ l^* & l_3 & 0 & 0 \end{pmatrix} , & \qquad
C^{21} &= \begin{pmatrix}
0 & 0 & -\ii l_1 & -\ii l_+ \\ 0 & 0 & -\ii l_- & -\ii l_1 \\
\ii l_1 & -\ii l_- & 0 & 0 \\ -\ii l_+ & \ii l_1 & 0 & 0
\end{pmatrix} \\
C^{02} &= \begin{pmatrix}
0 & 0 & \ii l_3 & \ii l \\ 0 & 0 & \ii l^* & -\ii l_3 \\
\ii l_3 & \ii l & 0 & 0 \\ \ii l^* & -\ii l_3 & 0 & 0 \end{pmatrix}
, & \qquad
C^{22} &= \begin{pmatrix}
0 & 0 & l_1 & -l_+ \\ 0 & 0 & l_- & -l_1 \\
-l_1 & -l_- & 0 & 0 \\ l_+ & l_1 & 0 & 0
\end{pmatrix} \\
C^{03} &= \begin{pmatrix}
0 & 0 & -l & -l_3 \\ 0 & 0 & l_3 & -l^* \\
-l & -l_3 & 0 & 0 \\ l_3 & -l^* & 0 & 0 \end{pmatrix} , & \qquad
C^{23} &= \begin{pmatrix}
0 & 0 & -\ii l_+ & \ii l_1 \\ 0 & 0 & -\ii l_1 & \ii l_- \\
-\ii l_- & -\ii l_1 & 0 & 0 \\ \ii l_1 & \ii l_+ & 0 & 0
\end{pmatrix} \\
C^{10} &= \begin{pmatrix}
0 & 0 & -l_+ & \ii l_2 \\ 0 & 0 & \ii l_2 & l_- \\
l_- & \ii l_2 & 0 & 0 \\ \ii l_2 & -l_+ & 0 & 0 \end{pmatrix} , &
\qquad
C^{30} &= \begin{pmatrix}
0 & 0 & l & l_0 \\ 0 & 0 & l_0 & l^* \\
l & -l_0 & 0 & 0 \\ -l_0 & l^* & 0 & 0
\end{pmatrix} \\
C^{11} &= \begin{pmatrix}
0 & 0 & \ii l_2 & -l_+ \\ 0 & 0 & l_- & \ii l_2 \\
-\ii l_2 & -l_- & 0 & 0 \\ l_+ & -\ii l_2 & 0 & 0 \end{pmatrix} , &
\qquad
C^{31} &= \begin{pmatrix}
0 & 0 & l_0 & l \\ 0 & 0 & l^* & l_0 \\
l_0 & -l & 0 & 0 \\ -l^* & l_0 & 0 & 0
\end{pmatrix} \\
C^{12} &= \begin{pmatrix}
0 & 0 & -l_2 & \ii l_+ \\ 0 & 0 & \ii l_- & l_2 \\
l_2 & \ii l_- & 0 & 0 \\ \ii l_+ & -l_2 & 0 & 0 \end{pmatrix} , &
\qquad
C^{32} &= \begin{pmatrix}
0 & 0 & \ii l_0 & -\ii l \\ 0 & 0 & \ii l^* & -\ii l_0 \\
\ii l_0 & \ii l & 0 & 0 \\ -\ii l^* & -\ii l_0 & 0 & 0
\end{pmatrix} \\
C^{13} &= \begin{pmatrix}
0 & 0 & -l_+ & -\ii l_2 \\ 0 & 0 & \ii l_2 & - l_- \\
-l_- & \ii l_2 & 0 & 0 \\ -\ii l_2 & -l_+ & 0 & 0 \end{pmatrix} , &
\qquad
C^{33} &= \begin{pmatrix}
0 & 0 & l & -l_0 \\ 0 & 0 & l_0 & -l^* \\
-l & -l_0 & 0 & 0 \\ l_0 & l^* & 0 & 0
\end{pmatrix}
\end{alignat}
\end{subequations}
and, with the abbreviation $\tilde{C}^{\mu\nu} \equiv C \gamma^5
\gamma^\nu \lbrack \fmslash{k} , \gamma^\mu \rbrack$ (note the
reversed order of the indices!)
\begin{subequations}
\begin{alignat}{2}
\tilde{C}^{00} &= \begin{pmatrix}
0 & 0 & -l & l_3 \\ 0 & 0 & l_3 & l^* \\
l & -l_3 & 0 & 0 \\ -l_3 & -l^* & 0 & 0 \end{pmatrix} , & \qquad
\tilde{C}^{20} &= \begin{pmatrix}
0 & 0 & -\ii l_- & \ii l_1 \\ 0 & 0 & \ii l_1 & -\ii l_+ \\
\ii l_+ & \ii l_1 & 0 & 0 \\ \ii l_1 & \ii l_- & 0 & 0
\end{pmatrix} \\
\tilde{C}^{01} &= \begin{pmatrix}
0 & 0 & -l_3 & -l^* \\ 0 & 0 & l & -l_3 \\
-l_3 & -l^* & 0 & 0 \\ l & -l_3 & 0 & 0 \end{pmatrix} , & \qquad
\tilde{C}^{21} &= \begin{pmatrix}
0 & 0 & -\ii l_1 & \ii l_+ \\ 0 & 0 & \ii l_- & -\ii l_1 \\
\ii l_1 & \ii l_- & 0 & 0 \\ \ii l_+ & \ii l_1 & 0 & 0
\end{pmatrix} \\
\tilde{C}^{02} &= \begin{pmatrix}
0 & 0 & -\ii l_3 & -\ii l^* \\ 0 & 0 & -\ii l & \ii l_3 \\
-\ii l_3 & -\ii l^* & 0 & 0 \\ -\ii l & \ii l_3 & 0 & 0
\end{pmatrix} , & \qquad
\tilde{C}^{22} &= \begin{pmatrix}
0 & 0 & l_1 & -l_+ \\ 0 & 0 & l_- & -l_1 \\
-l_1 & -l_- & 0 & 0 \\ l_+ & l_1 & 0 & 0
\end{pmatrix} \\
\tilde{C}^{03} &= \begin{pmatrix}
0 & 0 & l & -l_3 \\ 0 & 0 & l_3 & l^* \\
l & -l_3 & 0 & 0 \\ l_3 & l^* & 0 & 0 \end{pmatrix} , & \qquad
\tilde{C}^{23} &= \begin{pmatrix}
0 & 0 & \ii l_- & -\ii l_1 \\ 0 & 0 & \ii l_1 & -\ii l_+ \\
\ii l_+ & \ii l_1 & 0 & 0 \\ -\ii l_1 & -\ii l_- & 0 & 0
\end{pmatrix} \\
\tilde{C}^{10} &= \begin{pmatrix}
0 & 0 & -l_- & -\ii l_2 \\ 0 & 0 & -\ii l_2 & l_+ \\
l_+ & -\ii l_2 & 0 & 0 \\ -\ii l_2 & -l_- & 0 & 0 \end{pmatrix} , &
\qquad
\tilde{C}^{30} &= \begin{pmatrix}
0 & 0 & -l & l_0 \\ 0 & 0 & l_0 & -l^* \\
-l & -l_0 & 0 & 0 \\ -l_0 & -l^* & 0 & 0
\end{pmatrix} \\
\tilde{C}^{11} &= \begin{pmatrix}
0 & 0 & \ii l_2 & -l_+ \\ 0 & 0 & l_- & \ii l_2 \\
-\ii l_2 & -l_- & 0 & 0 \\ l_+ & -\ii l_2 & 0 & 0 \end{pmatrix} , &
\qquad
\tilde{C}^{31} &= \begin{pmatrix}
0 & 0 & -l_0 & l^* \\ 0 & 0 & l & -l_0 \\
-l_0 & -l^* & 0 & 0 \\ -l & -l_0 & 0 & 0
\end{pmatrix} \\
\tilde{C}^{12} &= \begin{pmatrix}
0 & 0 & -l_2 & -\ii l_+ \\ 0 & 0 & -\ii l_- & l_2 \\
l_2 & -\ii l_- & 0 & 0 \\ -\ii l_+ & -l_2 & 0 & 0 \end{pmatrix} , &
\qquad
\tilde{C}^{32} &= \begin{pmatrix}
0 & 0 & -\ii l_0 & \ii l^* \\ 0 & 0 & -\ii l & \ii l_0 \\
-\ii l_0 & -\ii l^* & 0 & 0 \\ \ii l & \ii l_0 & 0 & 0
\end{pmatrix} \\
\tilde{C}^{13} &= \begin{pmatrix}
0 & 0 & l_- & \ii l_2 \\ 0 & 0 & -\ii l_2 & l_+ \\
l_+ & -\ii l_2 & 0 & 0 \\ \ii l_2 & l_- & 0 & 0 \end{pmatrix} , &
\qquad
\tilde{C}^{33} &= \begin{pmatrix}
0 & 0 & l & -l_0 \\ 0 & 0 & l_0 & -l^* \\
-l & -l_0 & 0 & 0 \\ l_0 & l^* & 0 & 0
\end{pmatrix}
\end{alignat}
\end{subequations}
<<Implementation of bispinor currents>>=
pure function fggvvgr (v, psi, k) result (psikv)
type(bispinor) :: psikv
type(vectorspinor), intent(in) :: psi
type(vector), intent(in) :: v, k
complex(kind=default) :: kv30, kv21, kv01, kv31, kv02, kv32
complex(kind=default) :: ap, am, bp, bm, bps, bms
kv30 = k%x(3) * v%t - k%t * v%x(3)
kv21 = (0,1) * (k%x(2) * v%x(1) - k%x(1) * v%x(2))
kv01 = k%t * v%x(1) - k%x(1) * v%t
kv31 = k%x(3) * v%x(1) - k%x(1) * v%x(3)
kv02 = (0,1) * (k%t * v%x(2) - k%x(2) * v%t)
kv32 = (0,1) * (k%x(3) * v%x(2) - k%x(2) * v%x(3))
ap = 2 * (kv30 + kv21)
am = 2 * (-kv30 + kv21)
bp = 2 * (kv01 + kv31 + kv02 + kv32)
bm = 2 * (kv01 - kv31 + kv02 - kv32)
bps = 2 * (kv01 + kv31 - kv02 - kv32)
bms = 2 * (kv01 - kv31 - kv02 + kv32)
psikv%a(1) = (-ap) * psi%psi(1)%a(3) + bps * psi%psi(1)%a(4) &
+ (-bm) * psi%psi(2)%a(3) + (-ap) * psi%psi(2)%a(4) &
+ (0,1) * (bm * psi%psi(3)%a(3) + ap * psi%psi(3)%a(4)) &
+ ap * psi%psi(4)%a(3) + (-bps) * psi%psi(4)%a(4)
psikv%a(2) = bm * psi%psi(1)%a(3) + ap * psi%psi(1)%a(4) &
+ ap * psi%psi(2)%a(3) + (-bps) * psi%psi(2)%a(4) &
+ (0,1) * (ap * psi%psi(3)%a(3) - bps * psi%psi(3)%a(4)) &
+ bm * psi%psi(4)%a(3) + ap * psi%psi(4)%a(4)
psikv%a(3) = am * psi%psi(1)%a(1) + bms * psi%psi(1)%a(2) &
+ bp * psi%psi(2)%a(1) + (-am) * psi%psi(2)%a(2) &
+ (0,-1) * (bp * psi%psi(3)%a(1) + (-am) * psi%psi(3)%a(2)) &
+ am * psi%psi(4)%a(1) + bms * psi%psi(4)%a(2)
psikv%a(4) = bp * psi%psi(1)%a(1) + (-am) * psi%psi(1)%a(2) &
+ am * psi%psi(2)%a(1) + bms * psi%psi(2)%a(2) &
+ (0,1) * (am * psi%psi(3)%a(1) + bms * psi%psi(3)%a(2)) &
+ (-bp) * psi%psi(4)%a(1) + am * psi%psi(4)%a(2)
end function fggvvgr
@
<<Implementation of bispinor currents>>=
pure function f_vgr (g, v, psi, k) result (psikkkv)
type(bispinor) :: psikkkv
type(vectorspinor), intent(in) :: psi
type(vector), intent(in) :: v
type(momentum), intent(in) :: k
complex(kind=default), intent(in) :: g
type(vector) :: vk
vk = k
psikkkv = g * (fggvvgr (v, psi, vk))
end function f_vgr
@
<<Implementation of bispinor currents>>=
pure function f_vlrgr (gl, gr, v, psi, k) result (psikv)
type(bispinor) :: psikv
type(vectorspinor), intent(in) :: psi
type(vector), intent(in) :: v
type(momentum), intent(in) :: k
complex(kind=default), intent(in) :: gl, gr
type(vector) :: vk
vk = k
psikv = fggvvgr (v, psi, vk)
psikv%a(1:2) = gl * psikv%a(1:2)
psikv%a(3:4) = gr * psikv%a(3:4)
end function f_vlrgr
@
<<Declaration of bispinor currents>>=
public :: gr_potf, gr_sf, gr_pf, gr_vf, gr_vlrf, gr_slf, gr_srf, gr_slrf
@
<<Implementation of bispinor currents>>=
pure function gr_potf (g, phi, psi) result (phipsi)
type(vectorspinor) :: phipsi
complex(kind=default), intent(in) :: g
complex(kind=default), intent(in) :: phi
type(bispinor), intent(in) :: psi
phipsi%psi(1)%a(1) = (g * phi) * psi%a(3)
phipsi%psi(1)%a(2) = (g * phi) * psi%a(4)
phipsi%psi(1)%a(3) = (g * phi) * psi%a(1)
phipsi%psi(1)%a(4) = (g * phi) * psi%a(2)
phipsi%psi(2)%a(1) = (g * phi) * psi%a(4)
phipsi%psi(2)%a(2) = (g * phi) * psi%a(3)
phipsi%psi(2)%a(3) = ((-g) * phi) * psi%a(2)
phipsi%psi(2)%a(4) = ((-g) * phi) * psi%a(1)
phipsi%psi(3)%a(1) = ((0,-1) * g * phi) * psi%a(4)
phipsi%psi(3)%a(2) = ((0,1) * g * phi) * psi%a(3)
phipsi%psi(3)%a(3) = ((0,1) * g * phi) * psi%a(2)
phipsi%psi(3)%a(4) = ((0,-1) * g * phi) * psi%a(1)
phipsi%psi(4)%a(1) = (g * phi) * psi%a(3)
phipsi%psi(4)%a(2) = ((-g) * phi) * psi%a(4)
phipsi%psi(4)%a(3) = ((-g) * phi) * psi%a(1)
phipsi%psi(4)%a(4) = (g * phi) * psi%a(2)
end function gr_potf
@
<<Implementation of bispinor currents>>=
pure function grkgf (psi, k) result (kpsi)
type(vectorspinor) :: kpsi
complex(kind=default) :: kp, km, k12, k12s
type(bispinor), intent(in) :: psi
type(vector), intent(in) :: k
kp = k%t + k%x(3)
km = k%t - k%x(3)
k12 = k%x(1) + (0,1)*k%x(2)
k12s = k%x(1) - (0,1)*k%x(2)
kpsi%psi(1)%a(1) = km * psi%a(1) - k12s * psi%a(2)
kpsi%psi(1)%a(2) = (-k12) * psi%a(1) + kp * psi%a(2)
kpsi%psi(1)%a(3) = kp * psi%a(3) + k12s * psi%a(4)
kpsi%psi(1)%a(4) = k12 * psi%a(3) + km * psi%a(4)
kpsi%psi(2)%a(1) = k12s * psi%a(1) - km * psi%a(2)
kpsi%psi(2)%a(2) = (-kp) * psi%a(1) + k12 * psi%a(2)
kpsi%psi(2)%a(3) = k12s * psi%a(3) + kp * psi%a(4)
kpsi%psi(2)%a(4) = km * psi%a(3) + k12 * psi%a(4)
kpsi%psi(3)%a(1) = (0,1) * (k12s * psi%a(1) + km * psi%a(2))
kpsi%psi(3)%a(2) = (0,-1) * (kp * psi%a(1) + k12 * psi%a(2))
kpsi%psi(3)%a(3) = (0,1) * (k12s * psi%a(3) - kp * psi%a(4))
kpsi%psi(3)%a(4) = (0,1) * (km * psi%a(3) - k12 * psi%a(4))
kpsi%psi(4)%a(1) = -(km * psi%a(1) + k12s * psi%a(2))
kpsi%psi(4)%a(2) = k12 * psi%a(1) + kp * psi%a(2)
kpsi%psi(4)%a(3) = kp * psi%a(3) - k12s * psi%a(4)
kpsi%psi(4)%a(4) = k12 * psi%a(3) - km * psi%a(4)
end function grkgf
@
<<Implementation of bispinor currents>>=
pure function gr_sf (g, phi, psi, k) result (phipsi)
type(vectorspinor) :: phipsi
complex(kind=default), intent(in) :: g
complex(kind=default), intent(in) :: phi
type(bispinor), intent(in) :: psi
type(momentum), intent(in) :: k
type(vector) :: vk
vk = k
phipsi = (g * phi) * grkgf (psi, vk)
end function gr_sf
@
<<Implementation of bispinor currents>>=
pure function gr_slf (gl, phi, psi, k) result (phipsi)
type(vectorspinor) :: phipsi
complex(kind=default), intent(in) :: gl
complex(kind=default), intent(in) :: phi
type(bispinor), intent(in) :: psi
type(bispinor) :: psi_l
type(momentum), intent(in) :: k
psi_l%a(1:2) = psi%a(1:2)
psi_l%a(3:4) = 0
phipsi = gr_sf (gl, phi, psi_l, k)
end function gr_slf
@
<<Implementation of bispinor currents>>=
pure function gr_srf (gr, phi, psi, k) result (phipsi)
type(vectorspinor) :: phipsi
complex(kind=default), intent(in) :: gr
complex(kind=default), intent(in) :: phi
type(bispinor), intent(in) :: psi
type(bispinor) :: psi_r
type(momentum), intent(in) :: k
psi_r%a(1:2) = 0
psi_r%a(3:4) = psi%a(3:4)
phipsi = gr_sf (gr, phi, psi_r, k)
end function gr_srf
@
<<Implementation of bispinor currents>>=
pure function gr_slrf (gl, gr, phi, psi, k) result (phipsi)
type(vectorspinor) :: phipsi
complex(kind=default), intent(in) :: gl, gr
complex(kind=default), intent(in) :: phi
type(bispinor), intent(in) :: psi
type(bispinor) :: psi_r
type(momentum), intent(in) :: k
phipsi = gr_slf (gl, phi, psi, k) + gr_srf (gr, phi, psi, k)
end function gr_slrf
@
<<Implementation of bispinor currents>>=
pure function grkggf (psi, k) result (kpsi)
type(vectorspinor) :: kpsi
complex(kind=default) :: kp, km, k12, k12s
type(bispinor), intent(in) :: psi
type(vector), intent(in) :: k
kp = k%t + k%x(3)
km = k%t - k%x(3)
k12 = k%x(1) + (0,1)*k%x(2)
k12s = k%x(1) - (0,1)*k%x(2)
kpsi%psi(1)%a(1) = (-km) * psi%a(1) + k12s * psi%a(2)
kpsi%psi(1)%a(2) = k12 * psi%a(1) - kp * psi%a(2)
kpsi%psi(1)%a(3) = kp * psi%a(3) + k12s * psi%a(4)
kpsi%psi(1)%a(4) = k12 * psi%a(3) + km * psi%a(4)
kpsi%psi(2)%a(1) = (-k12s) * psi%a(1) + km * psi%a(2)
kpsi%psi(2)%a(2) = kp * psi%a(1) - k12 * psi%a(2)
kpsi%psi(2)%a(3) = k12s * psi%a(3) + kp * psi%a(4)
kpsi%psi(2)%a(4) = km * psi%a(3) + k12 * psi%a(4)
kpsi%psi(3)%a(1) = (0,-1) * (k12s * psi%a(1) + km * psi%a(2))
kpsi%psi(3)%a(2) = (0,1) * (kp * psi%a(1) + k12 * psi%a(2))
kpsi%psi(3)%a(3) = (0,1) * (k12s * psi%a(3) - kp * psi%a(4))
kpsi%psi(3)%a(4) = (0,1) * (km * psi%a(3) - k12 * psi%a(4))
kpsi%psi(4)%a(1) = km * psi%a(1) + k12s * psi%a(2)
kpsi%psi(4)%a(2) = -(k12 * psi%a(1) + kp * psi%a(2))
kpsi%psi(4)%a(3) = kp * psi%a(3) - k12s * psi%a(4)
kpsi%psi(4)%a(4) = k12 * psi%a(3) - km * psi%a(4)
end function grkggf
@
<<Implementation of bispinor currents>>=
pure function gr_pf (g, phi, psi, k) result (phipsi)
type(vectorspinor) :: phipsi
complex(kind=default), intent(in) :: g
complex(kind=default), intent(in) :: phi
type(bispinor), intent(in) :: psi
type(momentum), intent(in) :: k
type(vector) :: vk
vk = k
phipsi = (g * phi) * grkggf (psi, vk)
end function gr_pf
@
<<Implementation of bispinor currents>>=
pure function grkkggf (v, psi, k) result (psikv)
type(vectorspinor) :: psikv
type(bispinor), intent(in) :: psi
type(vector), intent(in) :: v, k
complex(kind=default) :: kv30, kv21, kv01, kv31, kv02, kv32
complex(kind=default) :: ap, am, bp, bm, bps, bms, imago
imago = (0.0_default,1.0_default)
kv30 = k%x(3) * v%t - k%t * v%x(3)
kv21 = imago * (k%x(2) * v%x(1) - k%x(1) * v%x(2))
kv01 = k%t * v%x(1) - k%x(1) * v%t
kv31 = k%x(3) * v%x(1) - k%x(1) * v%x(3)
kv02 = imago * (k%t * v%x(2) - k%x(2) * v%t)
kv32 = imago * (k%x(3) * v%x(2) - k%x(2) * v%x(3))
ap = 2 * (kv30 + kv21)
am = 2 * ((-kv30) + kv21)
bp = 2 * (kv01 + kv31 + kv02 + kv32)
bm = 2 * (kv01 - kv31 + kv02 - kv32)
bps = 2 * (kv01 + kv31 - kv02 - kv32)
bms = 2 * (kv01 - kv31 - kv02 + kv32)
psikv%psi(1)%a(1) = am * psi%a(3) + bms * psi%a(4)
psikv%psi(1)%a(2) = bp * psi%a(3) + (-am) * psi%a(4)
psikv%psi(1)%a(3) = (-ap) * psi%a(1) + bps * psi%a(2)
psikv%psi(1)%a(4) = bm * psi%a(1) + ap * psi%a(2)
psikv%psi(2)%a(1) = bms * psi%a(3) + am * psi%a(4)
psikv%psi(2)%a(2) = (-am) * psi%a(3) + bp * psi%a(4)
psikv%psi(2)%a(3) = (-bps) * psi%a(1) + ap * psi%a(2)
psikv%psi(2)%a(4) = (-ap) * psi%a(1) + (-bm) * psi%a(2)
psikv%psi(3)%a(1) = imago * (bms * psi%a(3) - am * psi%a(4))
psikv%psi(3)%a(2) = (-imago) * (am * psi%a(3) + bp * psi%a(4))
psikv%psi(3)%a(3) = (-imago) * (bps * psi%a(1) + ap * psi%a(2))
psikv%psi(3)%a(4) = imago * ((-ap) * psi%a(1) + bm * psi%a(2))
psikv%psi(4)%a(1) = am * psi%a(3) + (-bms) * psi%a(4)
psikv%psi(4)%a(2) = bp * psi%a(3) + am * psi%a(4)
psikv%psi(4)%a(3) = ap * psi%a(1) + bps * psi%a(2)
psikv%psi(4)%a(4) = (-bm) * psi%a(1) + ap * psi%a(2)
end function grkkggf
@
<<Implementation of bispinor currents>>=
pure function gr_vf (g, v, psi, k) result (psikv)
type(vectorspinor) :: psikv
type(bispinor), intent(in) :: psi
type(vector), intent(in) :: v
type(momentum), intent(in) :: k
complex(kind=default), intent(in) :: g
type(vector) :: vk
vk = k
psikv = g * (grkkggf (v, psi, vk))
end function gr_vf
@
<<Implementation of bispinor currents>>=
pure function gr_vlrf (gl, gr, v, psi, k) result (psikv)
type(vectorspinor) :: psikv
type(bispinor), intent(in) :: psi
type(bispinor) :: psi_l, psi_r
type(vector), intent(in) :: v
type(momentum), intent(in) :: k
complex(kind=default), intent(in) :: gl, gr
type(vector) :: vk
vk = k
psi_l%a(1:2) = psi%a(1:2)
psi_l%a(3:4) = 0
psi_r%a(1:2) = 0
psi_r%a(3:4) = psi%a(3:4)
psikv = gl * grkkggf (v, psi_l, vk) + gr * grkkggf (v, psi_r, vk)
end function gr_vlrf
@
<<Declaration of bispinor currents>>=
public :: v_grf, v_fgr
@
<<Declaration of bispinor currents>>=
public :: vlr_grf, vlr_fgr
@
$V^\mu = \psi_\rho^T C^{\mu\rho} \psi$
<<Implementation of bispinor currents>>=
pure function grkgggf (psil, psir, k) result (j)
type(vector) :: j
type(vectorspinor), intent(in) :: psil
type(bispinor), intent(in) :: psir
type(vector), intent(in) :: k
type(vectorspinor) :: c_psir0, c_psir1, c_psir2, c_psir3
complex(kind=default) :: kp, km, k12, k12s, ik2
kp = k%t + k%x(3)
km = k%t - k%x(3)
k12 = (k%x(1) + (0,1)*k%x(2))
k12s = (k%x(1) - (0,1)*k%x(2))
ik2 = (0,1) * k%x(2)
!!! New version:
c_psir0%psi(1)%a(1) = (-k%x(3)) * psir%a(3) + (-k12s) * psir%a(4)
c_psir0%psi(1)%a(2) = (-k12) * psir%a(3) + k%x(3) * psir%a(4)
c_psir0%psi(1)%a(3) = (-k%x(3)) * psir%a(1) + (-k12s) * psir%a(2)
c_psir0%psi(1)%a(4) = (-k12) * psir%a(1) + k%x(3) * psir%a(2)
c_psir0%psi(2)%a(1) = (-k12s) * psir%a(3) + (-k%x(3)) * psir%a(4)
c_psir0%psi(2)%a(2) = k%x(3) * psir%a(3) + (-k12) * psir%a(4)
c_psir0%psi(2)%a(3) = k12s * psir%a(1) + k%x(3) * psir%a(2)
c_psir0%psi(2)%a(4) = (-k%x(3)) * psir%a(1) + k12 * psir%a(2)
c_psir0%psi(3)%a(1) = (0,1) * ((-k12s) * psir%a(3) + k%x(3) * psir%a(4))
c_psir0%psi(3)%a(2) = (0,1) * (k%x(3) * psir%a(3) + k12 * psir%a(4))
c_psir0%psi(3)%a(3) = (0,1) * (k12s * psir%a(1) + (-k%x(3)) * psir%a(2))
c_psir0%psi(3)%a(4) = (0,1) * ((-k%x(3)) * psir%a(1) + (-k12) * psir%a(2))
c_psir0%psi(4)%a(1) = (-k%x(3)) * psir%a(3) + k12s * psir%a(4)
c_psir0%psi(4)%a(2) = (-k12) * psir%a(3) + (-k%x(3)) * psir%a(4)
c_psir0%psi(4)%a(3) = k%x(3) * psir%a(1) + (-k12s) * psir%a(2)
c_psir0%psi(4)%a(4) = k12 * psir%a(1) + k%x(3) * psir%a(2)
!!!
c_psir1%psi(1)%a(1) = (-ik2) * psir%a(3) + (-km) * psir%a(4)
c_psir1%psi(1)%a(2) = (-kp) * psir%a(3) + ik2 * psir%a(4)
c_psir1%psi(1)%a(3) = ik2 * psir%a(1) + (-kp) * psir%a(2)
c_psir1%psi(1)%a(4) = (-km) * psir%a(1) + (-ik2) * psir%a(2)
c_psir1%psi(2)%a(1) = (-km) * psir%a(3) + (-ik2) * psir%a(4)
c_psir1%psi(2)%a(2) = ik2 * psir%a(3) + (-kp) * psir%a(4)
c_psir1%psi(2)%a(3) = kp * psir%a(1) + (-ik2) * psir%a(2)
c_psir1%psi(2)%a(4) = ik2 * psir%a(1) + km * psir%a(2)
c_psir1%psi(3)%a(1) = ((0,-1) * km) * psir%a(3) + (-k%x(2)) * psir%a(4)
c_psir1%psi(3)%a(2) = (-k%x(2)) * psir%a(3) + ((0,1) * kp) * psir%a(4)
c_psir1%psi(3)%a(3) = ((0,1) * kp) * psir%a(1) + (-k%x(2)) * psir%a(2)
c_psir1%psi(3)%a(4) = (-k%x(2)) * psir%a(1) + ((0,-1) * km) * psir%a(2)
c_psir1%psi(4)%a(1) = (-ik2) * psir%a(3) + km * psir%a(4)
c_psir1%psi(4)%a(2) = (-kp) * psir%a(3) + (-ik2) * psir%a(4)
c_psir1%psi(4)%a(3) = (-ik2) * psir%a(1) + (-kp) * psir%a(2)
c_psir1%psi(4)%a(4) = km * psir%a(1) + (-ik2) * psir%a(2)
!!!
c_psir2%psi(1)%a(1) = (0,1) * (k%x(1) * psir%a(3) + km * psir%a(4))
c_psir2%psi(1)%a(2) = (0,-1) * (kp * psir%a(3) + k%x(1) * psir%a(4))
c_psir2%psi(1)%a(3) = (0,1) * ((-k%x(1)) * psir%a(1) + kp * psir%a(2))
c_psir2%psi(1)%a(4) = (0,1) * ((-km) * psir%a(1) + k%x(1) * psir%a(2))
c_psir2%psi(2)%a(1) = (0,1) * (km * psir%a(3) + k%x(1) * psir%a(4))
c_psir2%psi(2)%a(2) = (0,-1) * (k%x(1) * psir%a(3) + kp * psir%a(4))
c_psir2%psi(2)%a(3) = (0,-1) * (kp * psir%a(1) + (-k%x(1)) * psir%a(2))
c_psir2%psi(2)%a(4) = (0,-1) * (k%x(1) * psir%a(1) + (-km) * psir%a(2))
c_psir2%psi(3)%a(1) = (-km) * psir%a(3) + k%x(1) * psir%a(4)
c_psir2%psi(3)%a(2) = k%x(1) * psir%a(3) + (-kp) * psir%a(4)
c_psir2%psi(3)%a(3) = kp * psir%a(1) + k%x(1) * psir%a(2)
c_psir2%psi(3)%a(4) = k%x(1) * psir%a(1) + km * psir%a(2)
c_psir2%psi(4)%a(1) = (0,1) * (k%x(1) * psir%a(3) + (-km) * psir%a(4))
c_psir2%psi(4)%a(2) = (0,1) * ((-kp) * psir%a(3) + k%x(1) * psir%a(4))
c_psir2%psi(4)%a(3) = (0,1) * (k%x(1) * psir%a(1) + kp * psir%a(2))
c_psir2%psi(4)%a(4) = (0,1) * (km * psir%a(1) + k%x(1) * psir%a(2))
!!!
c_psir3%psi(1)%a(1) = (-k%t) * psir%a(3) - k12s * psir%a(4)
c_psir3%psi(1)%a(2) = k12 * psir%a(3) + k%t * psir%a(4)
c_psir3%psi(1)%a(3) = (-k%t) * psir%a(1) + k12s * psir%a(2)
c_psir3%psi(1)%a(4) = (-k12) * psir%a(1) + k%t * psir%a(2)
c_psir3%psi(2)%a(1) = (-k12s) * psir%a(3) + (-k%t) * psir%a(4)
c_psir3%psi(2)%a(2) = k%t * psir%a(3) + k12 * psir%a(4)
c_psir3%psi(2)%a(3) = (-k12s) * psir%a(1) + k%t * psir%a(2)
c_psir3%psi(2)%a(4) = (-k%t) * psir%a(1) + k12 * psir%a(2)
c_psir3%psi(3)%a(1) = (0,-1) * (k12s * psir%a(3) + (-k%t) * psir%a(4))
c_psir3%psi(3)%a(2) = (0,1) * (k%t * psir%a(3) + (-k12) * psir%a(4))
c_psir3%psi(3)%a(3) = (0,-1) * (k12s * psir%a(1) + k%t * psir%a(2))
c_psir3%psi(3)%a(4) = (0,-1) * (k%t * psir%a(1) + k12 * psir%a(2))
c_psir3%psi(4)%a(1) = (-k%t) * psir%a(3) + k12s * psir%a(4)
c_psir3%psi(4)%a(2) = k12 * psir%a(3) + (-k%t) * psir%a(4)
c_psir3%psi(4)%a(3) = k%t * psir%a(1) + k12s * psir%a(2)
c_psir3%psi(4)%a(4) = k12 * psir%a(1) + k%t * psir%a(2)
j%t = 2 * (psil * c_psir0)
j%x(1) = 2 * (psil * c_psir1)
j%x(2) = 2 * (psil * c_psir2)
j%x(3) = 2 * (psil * c_psir3)
end function grkgggf
@
<<Implementation of bispinor currents>>=
pure function v_grf (g, psil, psir, k) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: g
type(vectorspinor), intent(in) :: psil
type(bispinor), intent(in) :: psir
type(momentum), intent(in) :: k
type(vector) :: vk
vk = k
j = g * grkgggf (psil, psir, vk)
end function v_grf
@
<<Implementation of bispinor currents>>=
pure function vlr_grf (gl, gr, psil, psir, k) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: gl, gr
type(vectorspinor), intent(in) :: psil
type(bispinor), intent(in) :: psir
type(bispinor) :: psir_l, psir_r
type(momentum), intent(in) :: k
type(vector) :: vk
vk = k
psir_l%a(1:2) = psir%a(1:2)
psir_l%a(3:4) = 0
psir_r%a(1:2) = 0
psir_r%a(3:4) = psir%a(3:4)
j = gl * grkgggf (psil, psir_l, vk) + gr * grkgggf (psil, psir_r, vk)
end function vlr_grf
@
$V^\mu = \psi^T \tilde{C}^{\mu\rho} \psi_\rho$; remember the reversed
index order in $\tilde{C}$.
<<Implementation of bispinor currents>>=
pure function fggkggr (psil, psir, k) result (j)
type(vector) :: j
type(vectorspinor), intent(in) :: psir
type(bispinor), intent(in) :: psil
type(vector), intent(in) :: k
type(bispinor) :: c_psir0, c_psir1, c_psir2, c_psir3
complex(kind=default) :: kp, km, k12, k12s, ik1, ik2
kp = k%t + k%x(3)
km = k%t - k%x(3)
k12 = k%x(1) + (0,1)*k%x(2)
k12s = k%x(1) - (0,1)*k%x(2)
ik1 = (0,1) * k%x(1)
ik2 = (0,1) * k%x(2)
c_psir0%a(1) = k%x(3) * (psir%psi(1)%a(4) + psir%psi(4)%a(4) &
+ psir%psi(2)%a(3) + (0,1) * psir%psi(3)%a(3)) - &
k12 * (psir%psi(1)%a(3) + psir%psi(4)%a(3)) + &
k12s * (psir%psi(2)%a(4) + (0,1) * psir%psi(3)%a(4))
c_psir0%a(2) = k%x(3) * (psir%psi(1)%a(3) - psir%psi(4)%a(3) + &
psir%psi(2)%a(4) - (0,1) * psir%psi(3)%a(4)) + &
k12s * (psir%psi(1)%a(4) - psir%psi(4)%a(4)) - &
k12 * (psir%psi(2)%a(3) - (0,1) * psir%psi(3)%a(3))
c_psir0%a(3) = k%x(3) * (-psir%psi(1)%a(2) + psir%psi(4)%a(2) + &
psir%psi(2)%a(1) + (0,1) * psir%psi(3)%a(1)) + &
k12 * (psir%psi(1)%a(1) - psir%psi(4)%a(1)) + &
k12s * (psir%psi(2)%a(2) + (0,1) * psir%psi(3)%a(2))
c_psir0%a(4) = k%x(3) * (-psir%psi(1)%a(1) - psir%psi(4)%a(1) + &
psir%psi(2)%a(2) - (0,1) * psir%psi(3)%a(2)) - &
k12s * (psir%psi(1)%a(2) + psir%psi(4)%a(2)) - &
k12 * (psir%psi(2)%a(1) - (0,1) * psir%psi(3)%a(1))
!!!
c_psir1%a(1) = ik2 * (-psir%psi(1)%a(4) - psir%psi(4)%a(4) - &
psir%psi(2)%a(3) - (0,1) * psir%psi(3)%a(3)) - &
km * (psir%psi(1)%a(3) + psir%psi(4)%a(3)) + &
kp * (psir%psi(2)%a(4) + (0,1) * psir%psi(3)%a(4))
c_psir1%a(2) = ik2 * (-psir%psi(1)%a(3) - psir%psi(2)%a(4) + &
psir%psi(4)%a(3) + (0,1) * psir%psi(3)%a(4)) + &
kp * (psir%psi(1)%a(4) - psir%psi(4)%a(4)) - &
km * (psir%psi(2)%a(3) - (0,1) * psir%psi(3)%a(3))
c_psir1%a(3) = ik2 * (-psir%psi(1)%a(2) + psir%psi(2)%a(1) + &
psir%psi(4)%a(2) + (0,1) * psir%psi(3)%a(1)) + &
kp * (psir%psi(1)%a(1) - psir%psi(4)%a(1)) + &
km * (psir%psi(2)%a(2) + (0,1) * psir%psi(3)%a(2))
c_psir1%a(4) = ik2 * (-psir%psi(1)%a(1) + psir%psi(2)%a(2) - &
psir%psi(4)%a(1) - (0,1) * psir%psi(3)%a(2)) - &
km * (psir%psi(1)%a(2) + psir%psi(4)%a(2)) - &
kp * (psir%psi(2)%a(1) - (0,1) * psir%psi(3)%a(1))
!!!
c_psir2%a(1) = ik1 * (psir%psi(2)%a(3) + psir%psi(1)%a(4) &
+ psir%psi(4)%a(4) + (0,1) * psir%psi(3)%a(3)) - &
((0,1)*km) * (psir%psi(1)%a(3) + psir%psi(4)%a(3)) &
+ kp * (psir%psi(3)%a(4) - (0,1) * psir%psi(2)%a(4))
c_psir2%a(2) = ik1 * (psir%psi(1)%a(3) + psir%psi(2)%a(4) - &
psir%psi(4)%a(3) - (0,1) * psir%psi(3)%a(4)) - &
((0,1)*kp) * (psir%psi(1)%a(4) - psir%psi(4)%a(4)) &
- km * (psir%psi(3)%a(3) + (0,1) * psir%psi(2)%a(3))
c_psir2%a(3) = ik1 * (psir%psi(1)%a(2) - psir%psi(2)%a(1) - &
psir%psi(4)%a(2) - (0,1) * psir%psi(3)%a(1)) + &
((0,1)*kp) * (psir%psi(1)%a(1) - psir%psi(4)%a(1)) &
+ km * (psir%psi(3)%a(2) - (0,1) * psir%psi(2)%a(2))
c_psir2%a(4) = ik1 * (psir%psi(1)%a(1) - psir%psi(2)%a(2) + &
psir%psi(4)%a(1) + (0,1) * psir%psi(3)%a(2)) + &
((0,1)*km) * (psir%psi(1)%a(2) + psir%psi(4)%a(2)) - &
kp * (psir%psi(3)%a(1) + (0,1) * psir%psi(2)%a(1))
!!!
c_psir3%a(1) = k%t * (psir%psi(1)%a(4) + psir%psi(4)%a(4) + &
psir%psi(2)%a(3) + (0,1) * psir%psi(3)%a(3)) - &
k12 * (psir%psi(1)%a(3) + psir%psi(4)%a(3)) - &
k12s * (psir%psi(2)%a(4) + (0,1) * psir%psi(3)%a(4))
c_psir3%a(2) = k%t * (psir%psi(1)%a(3) - psir%psi(4)%a(3) + &
psir%psi(2)%a(4) - (0,1) * psir%psi(3)%a(4)) - &
k12s * (psir%psi(1)%a(4) - psir%psi(4)%a(4)) - &
k12 * (psir%psi(2)%a(3) - (0,1) * psir%psi(3)%a(3))
c_psir3%a(3) = k%t * (-psir%psi(1)%a(2) + psir%psi(2)%a(1) + &
psir%psi(4)%a(2) + (0,1) * psir%psi(3)%a(1)) - &
k12 * (psir%psi(1)%a(1) - psir%psi(4)%a(1)) + &
k12s * (psir%psi(2)%a(2) + (0,1) * psir%psi(3)%a(2))
c_psir3%a(4) = k%t * (-psir%psi(1)%a(1) + psir%psi(2)%a(2) - &
psir%psi(4)%a(1) - (0,1) * psir%psi(3)%a(2)) - &
k12s * (psir%psi(1)%a(2) + psir%psi(4)%a(2)) + &
k12 * (psir%psi(2)%a(1) - (0,1) * psir%psi(3)%a(1))
!!! Because we explicitly multiplied the charge conjugation matrix
!!! we have to omit it from the spinor product and take the
!!! ordinary product!
j%t = 2 * dot_product (conjg (psil%a), c_psir0%a)
j%x(1) = 2 * dot_product (conjg (psil%a), c_psir1%a)
j%x(2) = 2 * dot_product (conjg (psil%a), c_psir2%a)
j%x(3) = 2 * dot_product (conjg (psil%a), c_psir3%a)
end function fggkggr
@
<<Implementation of bispinor currents>>=
pure function v_fgr (g, psil, psir, k) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: g
type(vectorspinor), intent(in) :: psir
type(bispinor), intent(in) :: psil
type(momentum), intent(in) :: k
type(vector) :: vk
vk = k
j = g * fggkggr (psil, psir, vk)
end function v_fgr
@
<<Implementation of bispinor currents>>=
pure function vlr_fgr (gl, gr, psil, psir, k) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: gl, gr
type(vectorspinor), intent(in) :: psir
type(bispinor), intent(in) :: psil
type(bispinor) :: psil_l
type(bispinor) :: psil_r
type(momentum), intent(in) :: k
type(vector) :: vk
vk = k
psil_l%a(1:2) = psil%a(1:2)
psil_l%a(3:4) = 0
psil_r%a(1:2) = 0
psil_r%a(3:4) = psil%a(3:4)
j = gl * fggkggr (psil_l, psir, vk) + gr * fggkggr (psil_r, psir, vk)
end function vlr_fgr
@ \subsection{Gravitino 4-Couplings}
<<Declaration of bispinor currents>>=
public :: f_s2gr, f_svgr, f_slvgr, f_srvgr, f_slrvgr, f_pvgr, f_v2gr, f_v2lrgr
@
<<Implementation of bispinor currents>>=
pure function f_s2gr (g, phi1, phi2, psi) result (phipsi)
type(bispinor) :: phipsi
type(vectorspinor), intent(in) :: psi
complex(kind=default), intent(in) :: g
complex(kind=default), intent(in) :: phi1, phi2
phipsi = phi2 * f_potgr (g, phi1, psi)
end function f_s2gr
@
<<Implementation of bispinor currents>>=
pure function f_svgr (g, phi, v, grav) result (phigrav)
type(bispinor) :: phigrav
type(vectorspinor), intent(in) :: grav
type(vector), intent(in) :: v
complex(kind=default), intent(in) :: g, phi
phigrav = (g * phi) * fgvg5gr (grav, v)
end function f_svgr
@
<<Implementation of bispinor currents>>=
pure function f_slvgr (gl, phi, v, grav) result (phigrav)
type(bispinor) :: phigrav, phidum
type(vectorspinor), intent(in) :: grav
type(vector), intent(in) :: v
complex(kind=default), intent(in) :: gl, phi
phidum = (gl * phi) * fgvg5gr (grav, v)
phigrav%a(1:2) = phidum%a(1:2)
phigrav%a(3:4) = 0
end function f_slvgr
@
<<Implementation of bispinor currents>>=
pure function f_srvgr (gr, phi, v, grav) result (phigrav)
type(bispinor) :: phigrav, phidum
type(vectorspinor), intent(in) :: grav
type(vector), intent(in) :: v
complex(kind=default), intent(in) :: gr, phi
phidum = (gr * phi) * fgvg5gr (grav, v)
phigrav%a(1:2) = 0
phigrav%a(3:4) = phidum%a(3:4)
end function f_srvgr
@
<<Implementation of bispinor currents>>=
pure function f_slrvgr (gl, gr, phi, v, grav) result (phigrav)
type(bispinor) :: phigrav, phidum
type(vectorspinor), intent(in) :: grav
type(vector), intent(in) :: v
complex(kind=default), intent(in) :: gl, gr, phi
phigrav = f_slvgr (gl, phi, v, grav) + f_srvgr (gr, phi, v, grav)
end function f_slrvgr
@
<<Implementation of bispinor currents>>=
pure function f_pvgr (g, phi, v, grav) result (phigrav)
type(bispinor) :: phigrav
type(vectorspinor), intent(in) :: grav
type(vector), intent(in) :: v
complex(kind=default), intent(in) :: g, phi
phigrav = (g * phi) * fgvgr (grav, v)
end function f_pvgr
@
<<Implementation of bispinor currents>>=
pure function f_v2gr (g, v1, v2, grav) result (psi)
type(bispinor) :: psi
complex(kind=default), intent(in) :: g
type(vectorspinor), intent(in) :: grav
type(vector), intent(in) :: v1, v2
psi = g * fggvvgr (v2, grav, v1)
end function f_v2gr
@
<<Implementation of bispinor currents>>=
pure function f_v2lrgr (gl, gr, v1, v2, grav) result (psi)
type(bispinor) :: psi
complex(kind=default), intent(in) :: gl, gr
type(vectorspinor), intent(in) :: grav
type(vector), intent(in) :: v1, v2
psi = fggvvgr (v2, grav, v1)
psi%a(1:2) = gl * psi%a(1:2)
psi%a(3:4) = gr * psi%a(3:4)
end function f_v2lrgr
@
<<Declaration of bispinor currents>>=
public :: gr_s2f, gr_svf, gr_pvf, gr_slvf, gr_srvf, gr_slrvf, gr_v2f, gr_v2lrf
@
<<Implementation of bispinor currents>>=
pure function gr_s2f (g, phi1, phi2, psi) result (phipsi)
type(vectorspinor) :: phipsi
type(bispinor), intent(in) :: psi
complex(kind=default), intent(in) :: g
complex(kind=default), intent(in) :: phi1, phi2
phipsi = phi2 * gr_potf (g, phi1, psi)
end function gr_s2f
@
<<Implementation of bispinor currents>>=
pure function gr_svf (g, phi, v, psi) result (phipsi)
type(vectorspinor) :: phipsi
type(bispinor), intent(in) :: psi
type(vector), intent(in) :: v
complex(kind=default), intent(in) :: g, phi
phipsi = (g * phi) * grkggf (psi, v)
end function gr_svf
@
<<Implementation of bispinor currents>>=
pure function gr_slvf (gl, phi, v, psi) result (phipsi)
type(vectorspinor) :: phipsi
type(bispinor), intent(in) :: psi
type(bispinor) :: psi_l
type(vector), intent(in) :: v
complex(kind=default), intent(in) :: gl, phi
psi_l%a(1:2) = psi%a(1:2)
psi_l%a(3:4) = 0
phipsi = (gl * phi) * grkggf (psi_l, v)
end function gr_slvf
@
<<Implementation of bispinor currents>>=
pure function gr_srvf (gr, phi, v, psi) result (phipsi)
type(vectorspinor) :: phipsi
type(bispinor), intent(in) :: psi
type(bispinor) :: psi_r
type(vector), intent(in) :: v
complex(kind=default), intent(in) :: gr, phi
psi_r%a(1:2) = 0
psi_r%a(3:4) = psi%a(3:4)
phipsi = (gr * phi) * grkggf (psi_r, v)
end function gr_srvf
@
<<Implementation of bispinor currents>>=
pure function gr_slrvf (gl, gr, phi, v, psi) result (phipsi)
type(vectorspinor) :: phipsi
type(bispinor), intent(in) :: psi
type(bispinor) :: psi_r
type(vector), intent(in) :: v
complex(kind=default), intent(in) :: gl, gr, phi
phipsi = gr_slvf (gl, phi, v, psi) + gr_srvf (gr, phi, v, psi)
end function gr_slrvf
@
<<Implementation of bispinor currents>>=
pure function gr_pvf (g, phi, v, psi) result (phipsi)
type(vectorspinor) :: phipsi
type(bispinor), intent(in) :: psi
type(vector), intent(in) :: v
complex(kind=default), intent(in) :: g, phi
phipsi = (g * phi) * grkgf (psi, v)
end function gr_pvf
@
<<Implementation of bispinor currents>>=
pure function gr_v2f (g, v1, v2, psi) result (vvpsi)
type(vectorspinor) :: vvpsi
complex(kind=default), intent(in) :: g
type(bispinor), intent(in) :: psi
type(vector), intent(in) :: v1, v2
vvpsi = g * grkkggf (v2, psi, v1)
end function gr_v2f
@
<<Implementation of bispinor currents>>=
pure function gr_v2lrf (gl, gr, v1, v2, psi) result (vvpsi)
type(vectorspinor) :: vvpsi
complex(kind=default), intent(in) :: gl, gr
type(bispinor), intent(in) :: psi
type(bispinor) :: psi_l, psi_r
type(vector), intent(in) :: v1, v2
psi_l%a(1:2) = psi%a(1:2)
psi_l%a(3:4) = 0
psi_r%a(1:2) = 0
psi_r%a(3:4) = psi%a(3:4)
vvpsi = gl * grkkggf (v2, psi_l, v1) + gr * grkkggf (v2, psi_r, v1)
end function gr_v2lrf
@
<<Declaration of bispinor currents>>=
public :: s2_grf, s2_fgr, sv1_grf, sv2_grf, sv1_fgr, sv2_fgr, &
slv1_grf, slv2_grf, slv1_fgr, slv2_fgr, &
srv1_grf, srv2_grf, srv1_fgr, srv2_fgr, &
slrv1_grf, slrv2_grf, slrv1_fgr, slrv2_fgr, &
pv1_grf, pv2_grf, pv1_fgr, pv2_fgr, v2_grf, v2_fgr, &
v2lr_grf, v2lr_fgr
@
<<Implementation of bispinor currents>>=
pure function s2_grf (g, gravbar, phi, psi) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: g, phi
type(vectorspinor), intent(in) :: gravbar
type(bispinor), intent(in) :: psi
j = phi * pot_grf (g, gravbar, psi)
end function s2_grf
@
<<Implementation of bispinor currents>>=
pure function s2_fgr (g, psibar, phi, grav) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: g, phi
type(bispinor), intent(in) :: psibar
type(vectorspinor), intent(in) :: grav
j = phi * pot_fgr (g, psibar, grav)
end function s2_fgr
@
<<Implementation of bispinor currents>>=
pure function sv1_grf (g, gravbar, v, psi) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: g
type(vectorspinor), intent(in) :: gravbar
type(bispinor), intent(in) :: psi
type(vector), intent(in) :: v
j = g * grg5vgf (gravbar, psi, v)
end function sv1_grf
@
<<Implementation of bispinor currents>>=
pure function slv1_grf (gl, gravbar, v, psi) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: gl
type(vectorspinor), intent(in) :: gravbar
type(bispinor), intent(in) :: psi
type(bispinor) :: psi_l
type(vector), intent(in) :: v
psi_l%a(1:2) = psi%a(1:2)
psi_l%a(3:4) = 0
j = gl * grg5vgf (gravbar, psi_l, v)
end function slv1_grf
@
<<Implementation of bispinor currents>>=
pure function srv1_grf (gr, gravbar, v, psi) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: gr
type(vectorspinor), intent(in) :: gravbar
type(bispinor), intent(in) :: psi
type(bispinor) :: psi_r
type(vector), intent(in) :: v
psi_r%a(1:2) = 0
psi_r%a(3:4) = psi%a(3:4)
j = gr * grg5vgf (gravbar, psi_r, v)
end function srv1_grf
@
<<Implementation of bispinor currents>>=
pure function slrv1_grf (gl, gr, gravbar, v, psi) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: gl, gr
type(vectorspinor), intent(in) :: gravbar
type(bispinor), intent(in) :: psi
type(bispinor) :: psi_l, psi_r
type(vector), intent(in) :: v
psi_l%a(1:2) = psi%a(1:2)
psi_l%a(3:4) = 0
psi_r%a(1:2) = 0
psi_r%a(3:4) = psi%a(3:4)
j = gl * grg5vgf (gravbar, psi_l, v) + gr * grg5vgf (gravbar, psi_r, v)
end function slrv1_grf
@
\begin{subequations}
\begin{align}
C \gamma^0 \gamma^0 = - C \gamma^1 \gamma^1 = - C \gamma^2 \gamma^2
= C \gamma^3 \gamma^3 = C &= \begin{pmatrix}
0 & 1 & 0 & 0 \\ -1 & 0 & 0 & 0 \\ 0 & 0 & 0 & -1 \\ 0 & 0 & 1 & 0
\end{pmatrix} \\
C \gamma^0 \gamma^1 = - C \gamma^1 \gamma^0 &= \begin{pmatrix}
-1 & 0 & 0 & 0 \\ 0 & 1 & 0 & 0 \\ 0 & 0 & -1 & 0 \\ 0 & 0 & 0 & 1
\end{pmatrix} \\
C \gamma^0 \gamma^2 = - C \gamma^2 \gamma^0 &= \begin{pmatrix}
-\ii & 0 & 0 & 0 \\ 0 & -\ii & 0 & 0 \\ 0 & 0 & -\ii & 0 \\ 0 & 0 &
0 & -\ii \end{pmatrix} \\
C \gamma^0 \gamma^3 = - C \gamma^3 \gamma^0 &= \begin{pmatrix}
0 & 1 & 0 & 0 \\ 1 & 0 & 0 & 0 \\ 0 & 0 & 0 & 1 \\ 0 & 0 & 1 & 0
\end{pmatrix} \\
C \gamma^1 \gamma^2 = - C \gamma^2 \gamma^1 &= \begin{pmatrix}
0 & \ii & 0 & 0 \\ \ii & 0 & 0 & 0 \\ 0 & 0 & 0 & -\ii \\ 0 & 0 &
-\ii & 0 \end{pmatrix} \\
C \gamma^1 \gamma^3 = - C \gamma^3 \gamma^1 &= \begin{pmatrix}
-1 & 0 & 0 & 0 \\ 0 & -1 & 0 & 0 \\ 0 & 0 & 1 & 0 \\ 0 & 0 & 0 & 1
\end{pmatrix} \\
C \gamma^2 \gamma^3 = - C \gamma^3 \gamma^2 &= \begin{pmatrix}
-\ii & 0 & 0 & 0 \\ 0 & \ii & 0 & 0 \\ 0 & 0 & \ii & 0 \\ 0 & 0 & 0
& -\ii \end{pmatrix}
\end{align}
\end{subequations}
@
<<Implementation of bispinor currents>>=
pure function sv2_grf (g, gravbar, phi, psi) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: g, phi
type(vectorspinor), intent(in) :: gravbar
type(bispinor), intent(in) :: psi
type(vectorspinor) :: g0_psi, g1_psi, g2_psi, g3_psi
g0_psi%psi(1)%a(1:2) = - psi%a(1:2)
g0_psi%psi(1)%a(3:4) = psi%a(3:4)
g0_psi%psi(2)%a(1) = psi%a(2)
g0_psi%psi(2)%a(2) = psi%a(1)
g0_psi%psi(2)%a(3) = psi%a(4)
g0_psi%psi(2)%a(4) = psi%a(3)
g0_psi%psi(3)%a(1) = (0,-1) * psi%a(2)
g0_psi%psi(3)%a(2) = (0,1) * psi%a(1)
g0_psi%psi(3)%a(3) = (0,-1) * psi%a(4)
g0_psi%psi(3)%a(4) = (0,1) * psi%a(3)
g0_psi%psi(4)%a(1) = psi%a(1)
g0_psi%psi(4)%a(2) = - psi%a(2)
g0_psi%psi(4)%a(3) = psi%a(3)
g0_psi%psi(4)%a(4) = - psi%a(4)
g1_psi%psi(1)%a(1:4) = - g0_psi%psi(2)%a(1:4)
g1_psi%psi(2)%a(1:4) = - g0_psi%psi(1)%a(1:4)
g1_psi%psi(3)%a(1) = (0,1) * psi%a(1)
g1_psi%psi(3)%a(2) = (0,-1) * psi%a(2)
g1_psi%psi(3)%a(3) = (0,-1) * psi%a(3)
g1_psi%psi(3)%a(4) = (0,1) * psi%a(4)
g1_psi%psi(4)%a(1) = - psi%a(2)
g1_psi%psi(4)%a(2) = psi%a(1)
g1_psi%psi(4)%a(3) = psi%a(4)
g1_psi%psi(4)%a(4) = - psi%a(3)
g2_psi%psi(1)%a(1:4) = - g0_psi%psi(3)%a(1:4)
g2_psi%psi(2)%a(1:4) = - g1_psi%psi(3)%a(1:4)
g2_psi%psi(3)%a(1:4) = - g0_psi%psi(1)%a(1:4)
g2_psi%psi(4)%a(1) = (0,1) * psi%a(2)
g2_psi%psi(4)%a(2) = (0,1) * psi%a(1)
g2_psi%psi(4)%a(3) = (0,-1) * psi%a(4)
g2_psi%psi(4)%a(4) = (0,-1) * psi%a(3)
g3_psi%psi(1)%a(1:4) = - g0_psi%psi(4)%a(1:4)
g3_psi%psi(2)%a(1:4) = - g1_psi%psi(4)%a(1:4)
g3_psi%psi(3)%a(1:4) = - g2_psi%psi(4)%a(1:4)
g3_psi%psi(4)%a(1:4) = - g0_psi%psi(1)%a(1:4)
j%t = (g * phi) * (gravbar * g0_psi)
j%x(1) = (g * phi) * (gravbar * g1_psi)
j%x(2) = (g * phi) * (gravbar * g2_psi)
j%x(3) = (g * phi) * (gravbar * g3_psi)
end function sv2_grf
@
<<Implementation of bispinor currents>>=
pure function slv2_grf (gl, gravbar, phi, psi) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: gl, phi
type(vectorspinor), intent(in) :: gravbar
type(bispinor), intent(in) :: psi
type(bispinor) :: psi_l
psi_l%a(1:2) = psi%a(1:2)
psi_l%a(3:4) = 0
j = sv2_grf (gl, gravbar, phi, psi_l)
end function slv2_grf
@
<<Implementation of bispinor currents>>=
pure function srv2_grf (gr, gravbar, phi, psi) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: gr, phi
type(vectorspinor), intent(in) :: gravbar
type(bispinor), intent(in) :: psi
type(bispinor) :: psi_r
psi_r%a(1:2) = 0
psi_r%a(3:4) = psi%a(3:4)
j = sv2_grf (gr, gravbar, phi, psi_r)
end function srv2_grf
@
<<Implementation of bispinor currents>>=
pure function slrv2_grf (gl, gr, gravbar, phi, psi) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: gl, gr, phi
type(vectorspinor), intent(in) :: gravbar
type(bispinor), intent(in) :: psi
type(bispinor) :: psi_l, psi_r
psi_l%a(1:2) = psi%a(1:2)
psi_l%a(3:4) = 0
psi_r%a(1:2) = 0
psi_r%a(3:4) = psi%a(3:4)
j = sv2_grf (gl, gravbar, phi, psi_l) + sv2_grf (gr, gravbar, phi, psi_r)
end function slrv2_grf
@
<<Implementation of bispinor currents>>=
pure function sv1_fgr (g, psibar, v, grav) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: g
type(bispinor), intent(in) :: psibar
type(vectorspinor), intent(in) :: grav
type(vector), intent(in) :: v
j = g * fg5gkgr (psibar, grav, v)
end function sv1_fgr
@
<<Implementation of bispinor currents>>=
pure function slv1_fgr (gl, psibar, v, grav) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: gl
type(bispinor), intent(in) :: psibar
type(bispinor) :: psibar_l
type(vectorspinor), intent(in) :: grav
type(vector), intent(in) :: v
psibar_l%a(1:2) = psibar%a(1:2)
psibar_l%a(3:4) = 0
j = gl * fg5gkgr (psibar_l, grav, v)
end function slv1_fgr
@
<<Implementation of bispinor currents>>=
pure function srv1_fgr (gr, psibar, v, grav) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: gr
type(bispinor), intent(in) :: psibar
type(bispinor) :: psibar_r
type(vectorspinor), intent(in) :: grav
type(vector), intent(in) :: v
psibar_r%a(1:2) = 0
psibar_r%a(3:4) = psibar%a(3:4)
j = gr * fg5gkgr (psibar_r, grav, v)
end function srv1_fgr
@
<<Implementation of bispinor currents>>=
pure function slrv1_fgr (gl, gr, psibar, v, grav) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: gl, gr
type(bispinor), intent(in) :: psibar
type(bispinor) :: psibar_l, psibar_r
type(vectorspinor), intent(in) :: grav
type(vector), intent(in) :: v
psibar_l%a(1:2) = psibar%a(1:2)
psibar_l%a(3:4) = 0
psibar_r%a(1:2) = 0
psibar_r%a(3:4) = psibar%a(3:4)
j = gl * fg5gkgr (psibar_l, grav, v) + gr * fg5gkgr (psibar_r, grav, v)
end function slrv1_fgr
@
<<Implementation of bispinor currents>>=
pure function sv2_fgr (g, psibar, phi, grav) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: g, phi
type(bispinor), intent(in) :: psibar
type(vectorspinor), intent(in) :: grav
type(bispinor) :: g0_grav, g1_grav, g2_grav, g3_grav
g0_grav%a(1) = -grav%psi(1)%a(1) + grav%psi(2)%a(2) - &
(0,1) * grav%psi(3)%a(2) + grav%psi(4)%a(1)
g0_grav%a(2) = -grav%psi(1)%a(2) + grav%psi(2)%a(1) + &
(0,1) * grav%psi(3)%a(1) - grav%psi(4)%a(2)
g0_grav%a(3) = grav%psi(1)%a(3) + grav%psi(2)%a(4) - &
(0,1) * grav%psi(3)%a(4) + grav%psi(4)%a(3)
g0_grav%a(4) = grav%psi(1)%a(4) + grav%psi(2)%a(3) + &
(0,1) * grav%psi(3)%a(3) - grav%psi(4)%a(4)
!!!
g1_grav%a(1) = grav%psi(1)%a(2) - grav%psi(2)%a(1) + &
(0,1) * grav%psi(3)%a(1) - grav%psi(4)%a(2)
g1_grav%a(2) = grav%psi(1)%a(1) - grav%psi(2)%a(2) - &
(0,1) * grav%psi(3)%a(2) + grav%psi(4)%a(1)
g1_grav%a(3) = grav%psi(1)%a(4) + grav%psi(2)%a(3) - &
(0,1) * grav%psi(3)%a(3) + grav%psi(4)%a(4)
g1_grav%a(4) = grav%psi(1)%a(3) + grav%psi(2)%a(4) + &
(0,1) * grav%psi(3)%a(4) - grav%psi(4)%a(3)
!!!
g2_grav%a(1) = (0,1) * (-grav%psi(1)%a(2) - grav%psi(2)%a(1) + &
grav%psi(4)%a(2)) - grav%psi(3)%a(1)
g2_grav%a(2) = (0,1) * (grav%psi(1)%a(1) + grav%psi(2)%a(2) + &
grav%psi(4)%a(1)) - grav%psi(3)%a(2)
g2_grav%a(3) = (0,1) * (-grav%psi(1)%a(4) + grav%psi(2)%a(3) - &
grav%psi(4)%a(4)) + grav%psi(3)%a(3)
g2_grav%a(4) = (0,1) * (grav%psi(1)%a(3) - grav%psi(2)%a(4) - &
grav%psi(4)%a(3)) + grav%psi(3)%a(4)
!!!
g3_grav%a(1) = -grav%psi(1)%a(2) + grav%psi(2)%a(2) - &
(0,1) * grav%psi(3)%a(2) - grav%psi(4)%a(1)
g3_grav%a(2) = grav%psi(1)%a(1) - grav%psi(2)%a(1) - &
(0,1) * grav%psi(3)%a(1) - grav%psi(4)%a(2)
g3_grav%a(3) = -grav%psi(1)%a(2) - grav%psi(2)%a(4) + &
(0,1) * grav%psi(3)%a(4) + grav%psi(4)%a(3)
g3_grav%a(4) = -grav%psi(1)%a(4) + grav%psi(2)%a(3) + &
(0,1) * grav%psi(3)%a(3) + grav%psi(4)%a(4)
j%t = (g * phi) * (psibar * g0_grav)
j%x(1) = (g * phi) * (psibar * g1_grav)
j%x(2) = (g * phi) * (psibar * g2_grav)
j%x(3) = (g * phi) * (psibar * g3_grav)
end function sv2_fgr
@
<<Implementation of bispinor currents>>=
pure function slv2_fgr (gl, psibar, phi, grav) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: gl, phi
type(bispinor), intent(in) :: psibar
type(bispinor) :: psibar_l
type(vectorspinor), intent(in) :: grav
psibar_l%a(1:2) = psibar%a(1:2)
psibar_l%a(3:4) = 0
j = sv2_fgr (gl, psibar_l, phi, grav)
end function slv2_fgr
@
<<Implementation of bispinor currents>>=
pure function srv2_fgr (gr, psibar, phi, grav) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: gr, phi
type(bispinor), intent(in) :: psibar
type(bispinor) :: psibar_r
type(vectorspinor), intent(in) :: grav
psibar_r%a(1:2) = 0
psibar_r%a(3:4) = psibar%a(3:4)
j = sv2_fgr (gr, psibar_r, phi, grav)
end function srv2_fgr
@
<<Implementation of bispinor currents>>=
pure function slrv2_fgr (gl, gr, psibar, phi, grav) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: gl, gr, phi
type(bispinor), intent(in) :: psibar
type(bispinor) :: psibar_l, psibar_r
type(vectorspinor), intent(in) :: grav
psibar_l%a(1:2) = psibar%a(1:2)
psibar_l%a(3:4) = 0
psibar_r%a(1:2) = 0
psibar_r%a(3:4) = psibar%a(3:4)
j = sv2_fgr (gl, psibar_l, phi, grav) + sv2_fgr (gr, psibar_r, phi, grav)
end function slrv2_fgr
@
<<Implementation of bispinor currents>>=
pure function pv1_grf (g, gravbar, v, psi) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: g
type(vectorspinor), intent(in) :: gravbar
type(bispinor), intent(in) :: psi
type(vector), intent(in) :: v
j = g * grvgf (gravbar, psi, v)
end function pv1_grf
@
<<Implementation of bispinor currents>>=
pure function pv2_grf (g, gravbar, phi, psi) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: g, phi
type(vectorspinor), intent(in) :: gravbar
type(bispinor), intent(in) :: psi
type(bispinor) :: g5_psi
g5_psi%a(1:2) = - psi%a(1:2)
g5_psi%a(3:4) = psi%a(3:4)
j = sv2_grf (g, gravbar, phi, g5_psi)
end function pv2_grf
@
<<Implementation of bispinor currents>>=
pure function pv1_fgr (g, psibar, v, grav) result (j)
complex(kind=default) :: j
complex(kind=default), intent(in) :: g
type(bispinor), intent(in) :: psibar
type(vectorspinor), intent(in) :: grav
type(vector), intent(in) :: v
j = g * fgkgr (psibar, grav, v)
end function pv1_fgr
@
<<Implementation of bispinor currents>>=
pure function pv2_fgr (g, psibar, phi, grav) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: g, phi
type(vectorspinor), intent(in) :: grav
type(bispinor), intent(in) :: psibar
type(bispinor) :: psibar_g5
psibar_g5%a(1:2) = - psibar%a(1:2)
psibar_g5%a(3:4) = psibar%a(3:4)
j = sv2_fgr (g, psibar_g5, phi, grav)
end function pv2_fgr
@
<<Implementation of bispinor currents>>=
pure function v2_grf (g, gravbar, v, psi) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: g
type(vectorspinor), intent(in) :: gravbar
type(bispinor), intent(in) :: psi
type(vector), intent(in) :: v
j = -g * grkgggf (gravbar, psi, v)
end function v2_grf
@
<<Implementation of bispinor currents>>=
pure function v2lr_grf (gl, gr, gravbar, v, psi) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: gl, gr
type(vectorspinor), intent(in) :: gravbar
type(bispinor), intent(in) :: psi
type(bispinor) :: psi_l, psi_r
type(vector), intent(in) :: v
psi_l%a(1:2) = psi%a(1:2)
psi_l%a(3:4) = 0
psi_r%a(1:2) = 0
psi_r%a(3:4) = psi%a(3:4)
j = -(gl * grkgggf (gravbar, psi_l, v) + gr * grkgggf (gravbar, psi_r, v))
end function v2lr_grf
@
<<Implementation of bispinor currents>>=
pure function v2_fgr (g, psibar, v, grav) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: g
type(vectorspinor), intent(in) :: grav
type(bispinor), intent(in) :: psibar
type(vector), intent(in) :: v
j = -g * fggkggr (psibar, grav, v)
end function v2_fgr
@
<<Implementation of bispinor currents>>=
pure function v2lr_fgr (gl, gr, psibar, v, grav) result (j)
type(vector) :: j
complex(kind=default), intent(in) :: gl, gr
type(vectorspinor), intent(in) :: grav
type(bispinor), intent(in) :: psibar
type(bispinor) :: psibar_l, psibar_r
type(vector), intent(in) :: v
psibar_l%a(1:2) = psibar%a(1:2)
psibar_l%a(3:4) = 0
psibar_r%a(1:2) = 0
psibar_r%a(3:4) = psibar%a(3:4)
j = -(gl * fggkggr (psibar_l, grav, v) + gr * fggkggr (psibar_r, grav, v))
end function v2lr_fgr
@ \subsection{On Shell Wave Functions}
<<Declaration of bispinor on shell wave functions>>=
public :: u, v, ghost
@
\begin{subequations}
\begin{align}
\chi_+(\vec p) &=
\frac{1}{\sqrt{2|\vec p|(|\vec p|+p_3)}}
\begin{pmatrix} |\vec p|+p_3 \\ p_1 + \ii p_2 \end{pmatrix} \\
\chi_-(\vec p) &=
\frac{1}{\sqrt{2|\vec p|(|\vec p|+p_3)}}
\begin{pmatrix} - p_1 + \ii p_2 \\ |\vec p|+p_3 \end{pmatrix}
\end{align}
\end{subequations}
@
\begin{equation}
u_\pm(p) =
\begin{pmatrix}
\sqrt{p_0\mp|\vec p|} \cdot \chi_\pm(\vec p) \\
\sqrt{p_0\pm|\vec p|} \cdot \chi_\pm(\vec p)
\end{pmatrix}
\end{equation}
<<Implementation of bispinor on shell wave functions>>=
pure function u (mass, p, s) result (psi)
type(bispinor) :: psi
real(kind=default), intent(in) :: mass
type(momentum), intent(in) :: p
integer, intent(in) :: s
complex(kind=default), dimension(2) :: chip, chim
real(kind=default) :: pabs, norm, delta, m
m = abs(mass)
pabs = sqrt (dot_product (p%x, p%x))
if (m < epsilon (m) * pabs) then
delta = 0
else
delta = sqrt (max (p%t - pabs, 0._default))
end if
if (pabs + p%x(3) <= 1000 * epsilon (pabs) * pabs) then
chip = (/ cmplx ( 0.0, 0.0, kind=default), &
cmplx ( 1.0, 0.0, kind=default) /)
chim = (/ cmplx (-1.0, 0.0, kind=default), &
cmplx ( 0.0, 0.0, kind=default) /)
else
norm = 1 / sqrt (2*pabs*(pabs + p%x(3)))
chip = norm * (/ cmplx (pabs + p%x(3), kind=default), &
cmplx (p%x(1), p%x(2), kind=default) /)
chim = norm * (/ cmplx (-p%x(1), p%x(2), kind=default), &
cmplx (pabs + p%x(3), kind=default) /)
end if
if (s > 0) then
psi%a(1:2) = delta * chip
psi%a(3:4) = sqrt (p%t + pabs) * chip
else
psi%a(1:2) = sqrt (p%t + pabs) * chim
psi%a(3:4) = delta * chim
end if
pabs = m ! make the compiler happy and use m
if (mass < 0) then
psi%a(1:2) = - imago * psi%a(1:2)
psi%a(3:4) = + imago * psi%a(3:4)
end if
end function u
@
\begin{equation}
v_\pm(p) =
\begin{pmatrix}
\mp\sqrt{p_0\pm|\vec p|} \cdot \chi_\mp(\vec p) \\
\pm\sqrt{p_0\mp|\vec p|} \cdot \chi_\mp(\vec p)
\end{pmatrix}
\end{equation}
<<Implementation of bispinor on shell wave functions>>=
pure function v (mass, p, s) result (psi)
type(bispinor) :: psi
real(kind=default), intent(in) :: mass
type(momentum), intent(in) :: p
integer, intent(in) :: s
complex(kind=default), dimension(2) :: chip, chim
real(kind=default) :: pabs, norm, delta, m
pabs = sqrt (dot_product (p%x, p%x))
m = abs(mass)
if (m < epsilon (m) * pabs) then
delta = 0
else
delta = sqrt (max (p%t - pabs, 0._default))
end if
if (pabs + p%x(3) <= 1000 * epsilon (pabs) * pabs) then
chip = (/ cmplx ( 0.0, 0.0, kind=default), &
cmplx ( 1.0, 0.0, kind=default) /)
chim = (/ cmplx (-1.0, 0.0, kind=default), &
cmplx ( 0.0, 0.0, kind=default) /)
else
norm = 1 / sqrt (2*pabs*(pabs + p%x(3)))
chip = norm * (/ cmplx (pabs + p%x(3), kind=default), &
cmplx (p%x(1), p%x(2), kind=default) /)
chim = norm * (/ cmplx (-p%x(1), p%x(2), kind=default), &
cmplx (pabs + p%x(3), kind=default) /)
end if
if (s > 0) then
psi%a(1:2) = - sqrt (p%t + pabs) * chim
psi%a(3:4) = delta * chim
else
psi%a(1:2) = delta * chip
psi%a(3:4) = - sqrt (p%t + pabs) * chip
end if
pabs = m ! make the compiler happy and use m
if (mass < 0) then
psi%a(1:2) = - imago * psi%a(1:2)
psi%a(3:4) = + imago * psi%a(3:4)
end if
end function v
@
<<Implementation of bispinor on shell wave functions>>=
pure function ghost (m, p, s) result (psi)
type(bispinor) :: psi
real(kind=default), intent(in) :: m
type(momentum), intent(in) :: p
integer, intent(in) :: s
psi%a(:) = 0
select case (s)
case (1)
psi%a(1) = 1
psi%a(2:4) = 0
case (2)
psi%a(1) = 0
psi%a(2) = 1
psi%a(3:4) = 0
case (3)
psi%a(1:2) = 0
psi%a(3) = 1
psi%a(4) = 0
case (4)
psi%a(1:3) = 0
psi%a(4) = 1
case (5)
psi%a(1) = 1.4
psi%a(2) = - 2.3
psi%a(3) = - 71.5
psi%a(4) = 0.1
end select
end function ghost
@
\subsection{Off Shell Wave Functions}
This is the same as for the Dirac fermions except that the expressions for
[ubar] and [vbar] are missing.
<<Declaration of bispinor off shell wave functions>>=
public :: brs_u, brs_v
@
In momentum space we have:
\begin{equation}
brs u(p)=(-i) (\fmslash p-m)u(p)
\end{equation}
<<Implementation of bispinor off shell wave functions>>=
pure function brs_u (m, p, s) result (dpsi)
type(bispinor) :: dpsi, psi
real(kind=default), intent(in) :: m
type(momentum), intent(in) :: p
integer, intent(in) :: s
type (vector)::vp
complex(kind=default), parameter :: one = (1, 0)
vp=p
psi=u(m,p,s)
dpsi=cmplx(0.0,-1.0)*(f_vf(one,vp,psi)-m*psi)
end function brs_u
@
\begin{equation}
brs v(p)=i (\fmslash p+m)v(p)
\end{equation}
<<Implementation of bispinor off shell wave functions>>=
pure function brs_v (m, p, s) result (dpsi)
type(bispinor) :: dpsi, psi
real(kind=default), intent(in) :: m
type(momentum), intent(in) :: p
integer, intent(in) :: s
type (vector)::vp
complex(kind=default), parameter :: one = (1, 0)
vp=p
psi=v(m,p,s)
dpsi=cmplx(0.0,1.0)*(f_vf(one,vp,psi)+m*psi)
end function brs_v
@ \subsection{Propagators}
<<Declaration of bispinor propagators>>=
public :: pr_psi, pr_grav
public :: pj_psi, pg_psi
@
\begin{equation}
\frac{\ii(-\fmslash{p}+m)}{p^2-m^2+\ii m\Gamma}\psi
\end{equation}
NB: the sign of the momentum comes about because all momenta are
treated as \emph{outgoing} and the particle charge flow is therefore
opposite to the momentum.
<<Implementation of bispinor propagators>>=
pure function pr_psi (p, m, w, psi) result (ppsi)
type(bispinor) :: ppsi
type(momentum), intent(in) :: p
real(kind=default), intent(in) :: m, w
type(bispinor), intent(in) :: psi
type(vector) :: vp
complex(kind=default), parameter :: one = (1, 0)
vp = p
ppsi = (1 / cmplx (p*p - m**2, m*w, kind=default)) &
* (- f_vf (one, vp, psi) + m * psi)
end function pr_psi
@
\begin{equation}
\sqrt{\frac{\pi}{M\Gamma}}
(-\fmslash{p}+m)\psi
\end{equation}
<<Implementation of bispinor propagators>>=
pure function pj_psi (p, m, w, psi) result (ppsi)
type(bispinor) :: ppsi
type(momentum), intent(in) :: p
real(kind=default), intent(in) :: m, w
type(bispinor), intent(in) :: psi
type(vector) :: vp
complex(kind=default), parameter :: one = (1, 0)
vp = p
ppsi = (0, -1) * sqrt (PI / m / w) * (- f_vf (one, vp, psi) + m * psi)
end function pj_psi
@
<<Implementation of bispinor propagators>>=
pure function pg_psi (p, m, w, psi) result (ppsi)
type(bispinor) :: ppsi
type(momentum), intent(in) :: p
real(kind=default), intent(in) :: m, w
type(bispinor), intent(in) :: psi
type(vector) :: vp
complex(kind=default), parameter :: one = (1, 0)
vp = p
ppsi = gauss (p*p, m, w) * (- f_vf (one, vp, psi) + m * psi)
end function pg_psi
@
\begin{equation}
\dfrac{\ii\biggl\{(-\fmslash{p} + m)\left(-\eta_{\mu\nu} + \dfrac{p_\mu
p_\nu}{m^2}\right) + \dfrac{1}{3} \left(\gamma_\mu -\dfrac{p_\mu}{m}\right)
(\fmslash{p} + m)\left(\gamma_\nu -
\dfrac{p_\nu}{m}\right)\biggr\}}{p^2 - m^2 + \ii m
\Gamma} \; \psi^\nu
\end{equation}
<<Implementation of bispinor propagators>>=
pure function pr_grav (p, m, w, grav) result (propgrav)
type(vectorspinor) :: propgrav
type(momentum), intent(in) :: p
real(kind=default), intent(in) :: m, w
type(vectorspinor), intent(in) :: grav
type(vector) :: vp
type(bispinor) :: pgrav, ggrav, ggrav1, ggrav2, ppgrav
type(vectorspinor) :: etagrav_dum, etagrav, pppgrav, &
gg_grav_dum, gg_grav
complex(kind=default), parameter :: one = (1, 0)
real(kind=default) :: minv
integer :: i
vp = p
minv = 1/m
pgrav = p%t * grav%psi(1) - p%x(1) * grav%psi(2) - &
p%x(2) * grav%psi(3) - p%x(3) * grav%psi(4)
ggrav%a(1) = grav%psi(1)%a(3) - grav%psi(2)%a(4) + (0,1) * &
grav%psi(3)%a(4) - grav%psi(4)%a(3)
ggrav%a(2) = grav%psi(1)%a(4) - grav%psi(2)%a(3) - (0,1) * &
grav%psi(3)%a(3) + grav%psi(4)%a(4)
ggrav%a(3) = grav%psi(1)%a(1) + grav%psi(2)%a(2) - (0,1) * &
grav%psi(3)%a(2) + grav%psi(4)%a(1)
ggrav%a(4) = grav%psi(1)%a(2) + grav%psi(2)%a(1) + (0,1) * &
grav%psi(3)%a(1) - grav%psi(4)%a(2)
ggrav1 = ggrav - minv * pgrav
ggrav2 = f_vf (one, vp, ggrav1) + m * ggrav - pgrav
ppgrav = (-minv**2) * f_vf (one, vp, pgrav) + minv * pgrav
do i = 1, 4
etagrav_dum%psi(i) = f_vf (one, vp, grav%psi(i))
end do
etagrav = etagrav_dum - m * grav
pppgrav%psi(1) = p%t * ppgrav
pppgrav%psi(2) = p%x(1) * ppgrav
pppgrav%psi(3) = p%x(2) * ppgrav
pppgrav%psi(4) = p%x(3) * ppgrav
gg_grav_dum%psi(1) = p%t * ggrav2
gg_grav_dum%psi(2) = p%x(1) * ggrav2
gg_grav_dum%psi(3) = p%x(2) * ggrav2
gg_grav_dum%psi(4) = p%x(3) * ggrav2
gg_grav = gr_potf (one, one, ggrav2) - minv * gg_grav_dum
propgrav = (1 / cmplx (p*p - m**2, m*w, kind=default)) * &
(etagrav + pppgrav + (1/3.0_default) * gg_grav)
end function pr_grav
@
\section{Polarization vectorspinors}
Here we construct the wavefunctions for (massive) gravitinos out of
the wavefunctions of (massive) vectorbosons and (massive) Majorana
fermions.
\begin{subequations}
\begin{align}
\psi^\mu_{(u; 3/2)} (k) &= \; \epsilon^\mu_+ (k) \cdot u (k, +) \\
\psi^\mu_{(u; 1/2)} (k) &= \; \sqrt{\dfrac{1}{3}} \, \epsilon^\mu_+ (k)
\cdot u (k, -) + \sqrt{\dfrac{2}{3}} \, \epsilon^\mu_0 (k) \cdot
u (k, +) \\
\psi^\mu_{(u; -1/2)} (k) &= \; \sqrt{\dfrac{2}{3}} \, \epsilon^\mu_0 (k)
\cdot u (k, -) + \sqrt{\dfrac{1}{3}} \, \epsilon^\mu_- (k) \cdot
u (k, +) \\
\psi^\mu_{(u; -3/2)} (k) &= \; \epsilon^\mu_- (k) \cdot u (k, -)
\end{align}
\end{subequations}
and in the same manner for $\psi^\mu_{(v; s)}$ with $u$ replaced by
$v$ and with the conjugated polarization vectors. These gravitino
wavefunctions obey the Dirac equation, they are transverse and they
fulfill the irreducibility condition
\begin{equation}
\gamma_\mu \psi^\mu_{(u/v; s)} = 0 .
\end{equation}
<<[[omega_vspinor_polarizations.f90]]>>=
<<Copyleft>>
module omega_vspinor_polarizations
use kinds
use constants
use omega_vectors
use omega_bispinors
use omega_bispinor_couplings
use omega_vectorspinors
implicit none
<<Declaration of polarization vectorspinors>>
integer, parameter, public :: omega_vspinor_pols_2010_01_A = 0
contains
<<Implementation of polarization vectorspinors>>
end module omega_vspinor_polarizations
@
<<Declaration of polarization vectorspinors>>=
public :: ueps, veps
private :: eps
private :: outer_product
@
Here we implement the polarization vectors for vectorbosons with
trigonometric functions, without the rotating of components done in
HELAS~\cite{HELAS}. These are only used for generating the
polarization vectorspinors.
\begin{subequations}
\begin{align}
\epsilon^\mu_+(k) &=
\frac{- e^{+\ii\phi}}{\sqrt{2}}
\left(0; \cos\theta\cos\phi - \ii\sin\phi,
\cos\theta\sin\phi + \ii\cos\phi,
-\sin\theta \right) \\
\epsilon^\mu_-(k) &=
\frac{e^{-\ii\phi}}{\sqrt{2}}
\left(0; \cos\theta\cos\phi + \ii \sin\phi,
\cos\theta\sin\phi - \ii \cos\phi,
- \sin\theta \right) \\
\epsilon^\mu_0(k) &=
\frac{1}{m} \left(|\vec k|; k^0\sin\theta\cos\phi,
k^0\sin\theta\sin\phi,
k^0\cos\theta\right)
\end{align}
\end{subequations}
Determining the mass from the momenta is a numerically haphazardous for
light particles. Therefore, we accept some redundancy and pass the
mass explicitely. For the case that the momentum lies totally in the
$z$-direction we take the convention $\cos\phi=1$ and $\sin\phi=0$.
<<Implementation of polarization vectorspinors>>=
pure function eps (mass, k, s) result (e)
type(vector) :: e
real(kind=default), intent(in) :: mass
type(momentum), intent(in) :: k
integer, intent(in) :: s
real(kind=default) :: kabs, kabs2, sqrt2, m
real(kind=default) :: cos_phi, sin_phi, cos_th, sin_th
complex(kind=default) :: epiphi, emiphi
sqrt2 = sqrt (2.0_default)
kabs2 = dot_product (k%x, k%x)
m = abs(mass)
if (kabs2 > 0) then
kabs = sqrt (kabs2)
if ((k%x(1) == 0) .and. (k%x(2) == 0)) then
cos_phi = 1
sin_phi = 0
else
cos_phi = k%x(1) / sqrt(k%x(1)**2 + k%x(2)**2)
sin_phi = k%x(2) / sqrt(k%x(1)**2 + k%x(2)**2)
end if
cos_th = k%x(3) / kabs
sin_th = sqrt(1 - cos_th**2)
epiphi = cos_phi + (0,1) * sin_phi
emiphi = cos_phi - (0,1) * sin_phi
e%t = 0
e%x = 0
select case (s)
case (1)
e%x(1) = epiphi * (-cos_th * cos_phi + (0,1) * sin_phi) / sqrt2
e%x(2) = epiphi * (-cos_th * sin_phi - (0,1) * cos_phi) / sqrt2
e%x(3) = epiphi * ( sin_th / sqrt2)
case (-1)
e%x(1) = emiphi * ( cos_th * cos_phi + (0,1) * sin_phi) / sqrt2
e%x(2) = emiphi * ( cos_th * sin_phi - (0,1) * cos_phi) / sqrt2
e%x(3) = emiphi * (-sin_th / sqrt2)
case (0)
if (m > 0) then
e%t = kabs / m
e%x = k%t / (m*kabs) * k%x
end if
case (4)
if (m > 0) then
e = (1 / m) * k
else
e = (1 / k%t) * k
end if
end select
else !!! for particles in their rest frame defined to be
!!! polarized along the 3-direction
e%t = 0
e%x = 0
select case (s)
case (1)
e%x(1) = cmplx ( - 1, 0, kind=default) / sqrt2
e%x(2) = cmplx ( 0, 1, kind=default) / sqrt2
case (-1)
e%x(1) = cmplx ( 1, 0, kind=default) / sqrt2
e%x(2) = cmplx ( 0, 1, kind=default) / sqrt2
case (0)
if (m > 0) then
e%x(3) = 1
end if
case (4)
if (m > 0) then
e = (1 / m) * k
else
e = (1 / k%t) * k
end if
end select
end if
end function eps
@
<<Implementation of polarization vectorspinors>>=
pure function ueps (m, k, s) result (t)
type(vectorspinor) :: t
real(kind=default), intent(in) :: m
type(momentum), intent(in) :: k
integer, intent(in) :: s
integer :: i
type(vector) :: ep, e0, em
type(bispinor) :: up, um
do i = 1, 4
t%psi(i)%a = 0
end do
select case (s)
case (2)
ep = eps (m, k, 1)
up = u (m, k, 1)
t = outer_product (ep, up)
case (1)
ep = eps (m, k, 1)
e0 = eps (m, k, 0)
up = u (m, k, 1)
um = u (m, k, -1)
t = (1 / sqrt (3.0_default)) * (outer_product (ep, um) &
+ sqrt (2.0_default) * outer_product (e0, up))
case (-1)
e0 = eps (m, k, 0)
em = eps (m, k, -1)
up = u (m, k, 1)
um = u (m, k, -1)
t = (1 / sqrt (3.0_default)) * (sqrt (2.0_default) * &
outer_product (e0, um) + outer_product (em, up))
case (-2)
em = eps (m, k, -1)
um = u (m, k, -1)
t = outer_product (em, um)
end select
end function ueps
@
<<Implementation of polarization vectorspinors>>=
pure function veps (m, k, s) result (t)
type(vectorspinor) :: t
real(kind=default), intent(in) :: m
type(momentum), intent(in) :: k
integer, intent(in) :: s
integer :: i
type(vector) :: ep, e0, em
type(bispinor) :: vp, vm
do i = 1, 4
t%psi(i)%a = 0
end do
select case (s)
case (2)
ep = conjg(eps (m, k, 1))
vp = v (m, k, 1)
t = outer_product (ep, vp)
case (1)
ep = conjg(eps (m, k, 1))
e0 = conjg(eps (m, k, 0))
vp = v (m, k, 1)
vm = v (m, k, -1)
t = (1 / sqrt (3.0_default)) * (outer_product (ep, vm) &
+ sqrt (2.0_default) * outer_product (e0, vp))
case (-1)
e0 = conjg(eps (m, k, 0))
em = conjg(eps (m, k, -1))
vp = v (m, k, 1)
vm = v (m, k, -1)
t = (1 / sqrt (3.0_default)) * (sqrt (2.0_default) &
* outer_product (e0, vm) + outer_product (em, vp))
case (-2)
em = conjg(eps (m, k, -1))
vm = v (m, k, -1)
t = outer_product (em, vm)
end select
end function veps
@
<<Implementation of polarization vectorspinors>>=
pure function outer_product (ve, sp) result (vs)
type(vectorspinor) :: vs
type(vector), intent(in) :: ve
type(bispinor), intent(in) :: sp
integer :: i
vs%psi(1)%a(1:4) = ve%t * sp%a(1:4)
do i = 1, 3
vs%psi((i+1))%a(1:4) = ve%x(i) * sp%a(1:4)
end do
end function outer_product
@ \section{Color}
<<[[omega_color.f90]]>>=
<<Copyleft>>
module omega_color
use kinds
implicit none
private
<<Declaration of color types>>
<<Declaration of color functions>>
integer, parameter, public :: omega_color_2010_01_A = 0
contains
<<Implementation of color functions>>
end module omega_color
@ \subsection{Color Sum}
<<Declaration of color types>>=
public :: omega_color_factor
type omega_color_factor
integer :: i1, i2
complex(kind=default) :: factor
end type omega_color_factor
@
<<Declaration of color functions>>=
public :: omega_color_sum
@
<<Implementation of color functions>>=
pure function omega_color_sum (flv, hel, amp, cf) result (amp2)
complex(kind=default) :: amp2
integer, intent(in) :: flv, hel
complex(kind=default), dimension(:,:,:), intent(in) :: amp
type(omega_color_factor), dimension(:), intent(in) :: cf
integer :: n
amp2 = 0
do n = 1, size (cf)
amp2 = amp2 &
+ cf(n)%factor * amp(flv,cf(n)%i1,hel) * conjg (amp(flv,cf(n)%i2,hel))
end do
end function omega_color_sum
@ \section{Utilities}
<<[[omega_utils.f90]]>>=
<<Copyleft>>
module omega_utils
use kinds
use omega_vectors
use omega_polarizations
implicit none
private
<<Declaration of utility functions>>
<<Numerical tolerances>>
integer, parameter, public :: omega_utils_2010_01_A = 0
contains
<<Implementation of utility functions>>
end module omega_utils
@ \subsection{Helicity Selection Rule Heuristics}
<<Declaration of utility functions>>=
public :: omega_update_helicity_selection
@
<<Implementation of utility functions>>=
pure subroutine omega_update_helicity_selection &
(count, amp, max_abs, sum_abs, mask, threshold, cutoff, mask_dirty)
integer, intent(inout) :: count
complex(kind=default), dimension(:,:,:), intent(in) :: amp
real(kind=default), dimension(:), intent(inout) :: max_abs
real(kind=default), intent(inout) :: sum_abs
logical, dimension(:), intent(inout) :: mask
real(kind=default), intent(in) :: threshold
integer, intent(in) :: cutoff
logical, intent(out) :: mask_dirty
integer :: h
real(kind=default) :: avg
mask_dirty = .false.
if (threshold > 0) then
count = count + 1
if (count <= cutoff) then
forall (h = lbound (amp, 3) : ubound (amp, 3))
max_abs(h) = max (max_abs(h), maxval (abs (amp(:,:,h))))
end forall
sum_abs = sum_abs + sum (abs (amp))
if (count == cutoff) then
avg = sum_abs / size (amp) / cutoff
mask = max_abs >= threshold * epsilon (avg) * avg
mask_dirty = .true.
end if
end if
end if
end subroutine omega_update_helicity_selection
@ \subsection{Diagnostics}
<<Declaration of utility functions>>=
public :: omega_report_helicity_selection
@ We shoul try to use [[msg_message]] from WHIZARD's [[diagnostics]] module,
but this would spoil independent builds.
<<Implementation of utility functions>>=
subroutine omega_report_helicity_selection (mask, spin_states, threshold, unit)
logical, dimension(:), intent(in) :: mask
integer, dimension(:,:), intent(in) :: spin_states
real(kind=default), intent(in) :: threshold
integer, intent(in), optional :: unit
integer :: u
integer :: h, i
if (present(unit)) then
u = unit
else
u = 6
end if
if (u >= 0) then
write (unit = u, &
fmt = "('| ','Contributing Helicity Combinations: ', I5, ' of ', I5)") &
count (mask), size (mask)
write (unit = u, &
fmt = "('| ','Threshold: amp / avg > ', E9.2, ' = ', E9.2, ' * epsilon()')") &
threshold * epsilon (threshold), threshold
i = 0
do h = 1, size (mask)
if (mask(h)) then
i = i + 1
write (unit = u, fmt = "('| ',I4,': ',20I4)") i, spin_states (:, h)
end if
end do
end if
end subroutine omega_report_helicity_selection
@
<<Declaration of utility functions>>=
public :: omega_ward_warn, omega_ward_panic
@ The O'Mega amplitudes have only one particle off shell and are the
sum of \emph{all} possible diagrams with the other particles
on-shell.
\begin{dubious}
The problem with these gauge checks is that are numerically very
small amplitudes that vanish analytically and that violate
transversality. The hard part is to determine the thresholds that
make threse tests usable.
\end{dubious}
<<Implementation of utility functions>>=
subroutine omega_ward_warn (name, m, k, e)
character(len=*), intent(in) :: name
real(kind=default), intent(in) :: m
type(momentum), intent(in) :: k
type(vector), intent(in) :: e
type(vector) :: ek
real(kind=default) :: abs_eke, abs_ek_abs_e
ek = eps (m, k, 4)
abs_eke = abs (ek * e)
abs_ek_abs_e = abs (ek) * abs (e)
print *, name, ":", abs_eke / abs_ek_abs_e, abs (ek), abs (e)
if (abs_eke > 1000 * epsilon (abs_ek_abs_e)) then
print *, "O'Mega: warning: non-transverse vector field: ", &
name, ":", abs_eke / abs_ek_abs_e, abs (e)
end if
end subroutine omega_ward_warn
@
<<Implementation of utility functions>>=
subroutine omega_ward_panic (name, m, k, e)
character(len=*), intent(in) :: name
real(kind=default), intent(in) :: m
type(momentum), intent(in) :: k
type(vector), intent(in) :: e
type(vector) :: ek
real(kind=default) :: abs_eke, abs_ek_abs_e
ek = eps (m, k, 4)
abs_eke = abs (ek * e)
abs_ek_abs_e = abs (ek) * abs (e)
if (abs_eke > 1000 * epsilon (abs_ek_abs_e)) then
print *, "O'Mega: panic: non-transverse vector field: ", &
name, ":", abs_eke / abs_ek_abs_e, abs (e)
stop
end if
end subroutine omega_ward_panic
@
<<Declaration of utility functions>>=
public :: omega_slavnov_warn, omega_slavnov_panic
@
<<Implementation of utility functions>>=
subroutine omega_slavnov_warn (name, m, k, e, phi)
character(len=*), intent(in) :: name
real(kind=default), intent(in) :: m
type(momentum), intent(in) :: k
type(vector), intent(in) :: e
complex(kind=default), intent(in) :: phi
type(vector) :: ek
real(kind=default) :: abs_eke, abs_ek_abs_e
ek = eps (m, k, 4)
abs_eke = abs (ek * e - phi)
abs_ek_abs_e = abs (ek) * abs (e)
print *, name, ":", abs_eke / abs_ek_abs_e, abs (ek), abs (e)
if (abs_eke > 1000 * epsilon (abs_ek_abs_e)) then
print *, "O'Mega: warning: non-transverse vector field: ", &
name, ":", abs_eke / abs_ek_abs_e, abs (e)
end if
end subroutine omega_slavnov_warn
@
<<Implementation of utility functions>>=
subroutine omega_slavnov_panic (name, m, k, e, phi)
character(len=*), intent(in) :: name
real(kind=default), intent(in) :: m
type(momentum), intent(in) :: k
type(vector), intent(in) :: e
complex(kind=default), intent(in) :: phi
type(vector) :: ek
real(kind=default) :: abs_eke, abs_ek_abs_e
ek = eps (m, k, 4)
abs_eke = abs (ek * e - phi)
abs_ek_abs_e = abs (ek) * abs (e)
if (abs_eke > 1000 * epsilon (abs_ek_abs_e)) then
print *, "O'Mega: panic: non-transverse vector field: ", &
name, ":", abs_eke / abs_ek_abs_e, abs (e)
stop
end if
end subroutine omega_slavnov_panic
@
<<Declaration of utility functions>>=
public :: omega_check_arguments_warn, omega_check_arguments_panic
@
<<Implementation of utility functions>>=
subroutine omega_check_arguments_warn (n, k)
integer, intent(in) :: n
real(kind=default), dimension(0:,:), intent(in) :: k
integer :: i
i = size(k,dim=1)
if (i /= 4) then
print *, "O'Mega: warning: wrong # of dimensions:", i
end if
i = size(k,dim=2)
if (i /= n) then
print *, "O'Mega: warning: wrong # of momenta:", i, &
", expected", n
end if
end subroutine omega_check_arguments_warn
@
<<Implementation of utility functions>>=
subroutine omega_check_arguments_panic (n, k)
integer, intent(in) :: n
real(kind=default), dimension(0:,:), intent(in) :: k
logical :: error
integer :: i
error = .false.
i = size(k,dim=1)
if (i /= n) then
print *, "O'Mega: warning: wrong # of dimensions:", i
error = .true.
end if
i = size(k,dim=2)
if (i /= n) then
print *, "O'Mega: warning: wrong # of momenta:", i, &
", expected", n
error = .true.
end if
if (error) then
stop
end if
end subroutine omega_check_arguments_panic
@
<<Declaration of utility functions>>=
public :: omega_check_helicities_warn, omega_check_helicities_panic
private :: omega_check_helicity
@
<<Implementation of utility functions>>=
function omega_check_helicity (m, smax, s) result (error)
real(kind=default), intent(in) :: m
integer, intent(in) :: smax, s
logical :: error
select case (smax)
case (0)
error = (s /= 0)
case (1)
error = (abs (s) /= 1)
case (2)
if (m == 0.0_default) then
error = .not. (abs (s) == 1 .or. abs (s) == 4)
else
error = .not. (abs (s) <= 1 .or. abs (s) == 4)
end if
case (4)
error = .true.
case default
error = .true.
end select
end function omega_check_helicity
@
<<Implementation of utility functions>>=
subroutine omega_check_helicities_warn (m, smax, s)
real(kind=default), dimension(:), intent(in) :: m
integer, dimension(:), intent(in) :: smax, s
integer :: i
do i = 1, size (m)
if (omega_check_helicity (m(i), smax(i), s(i))) then
print *, "O'Mega: warning: invalid helicity", s(i)
end if
end do
end subroutine omega_check_helicities_warn
@
<<Implementation of utility functions>>=
subroutine omega_check_helicities_panic (m, smax, s)
real(kind=default), dimension(:), intent(in) :: m
integer, dimension(:), intent(in) :: smax, s
logical :: error
logical :: error1
integer :: i
error = .false.
do i = 1, size (m)
error1 = omega_check_helicity (m(i), smax(i), s(i))
if (error1) then
print *, "O'Mega: panic: invalid helicity", s(i)
error = .true.
end if
end do
if (error) then
stop
end if
end subroutine omega_check_helicities_panic
@
<<Declaration of utility functions>>=
public :: omega_check_momenta_warn, omega_check_momenta_panic
private :: check_momentum_conservation, check_mass_shell
@
<<Numerical tolerances>>=
integer, parameter, private :: MOMENTUM_TOLERANCE = 10000
@
<<Implementation of utility functions>>=
function check_momentum_conservation (k) result (error)
real(kind=default), dimension(0:,:), intent(in) :: k
logical :: error
error = any (abs (sum (k(:,3:), dim = 2) - k(:,1) - k(:,2)) > &
MOMENTUM_TOLERANCE * epsilon (maxval (abs (k), dim = 2)))
if (error) then
print *, sum (k(:,3:), dim = 2) - k(:,1) - k(:,2)
print *, MOMENTUM_TOLERANCE * epsilon (maxval (abs (k), dim = 2)), &
maxval (abs (k), dim = 2)
end if
end function check_momentum_conservation
@
<<Numerical tolerances>>=
integer, parameter, private :: ON_SHELL_TOLERANCE = 1000000
@
<<Implementation of utility functions>>=
function check_mass_shell (m, k) result (error)
real(kind=default), intent(in) :: m
real(kind=default), dimension(0:), intent(in) :: k
real(kind=default) :: e2
logical :: error
e2 = k(1)**2 + k(2)**2 + k(3)**2 + m**2
error = abs (k(0)**2 - e2) > ON_SHELL_TOLERANCE * epsilon (max (k(0)**2, e2))
if (error) then
print *, k(0)**2 - e2
print *, ON_SHELL_TOLERANCE * epsilon (max (k(0)**2, e2)), max (k(0)**2, e2)
end if
end function check_mass_shell
@
<<Implementation of utility functions>>=
subroutine omega_check_momenta_warn (m, k)
real(kind=default), dimension(:), intent(in) :: m
real(kind=default), dimension(0:,:), intent(in) :: k
integer :: i
if (check_momentum_conservation (k)) then
print *, "O'Mega: warning: momentum not conserved"
end if
do i = 1, size(m)
if (check_mass_shell (m(i), k(:,i))) then
print *, "O'Mega: warning: particle #", i, "not on-shell"
end if
end do
end subroutine omega_check_momenta_warn
@
<<Implementation of utility functions>>=
subroutine omega_check_momenta_panic (m, k)
real(kind=default), dimension(:), intent(in) :: m
real(kind=default), dimension(0:,:), intent(in) :: k
logical :: error
logical :: error1
integer :: i
error = check_momentum_conservation (k)
if (error) then
print *, "O'Mega: panic: momentum not conserved"
end if
do i = 1, size(m)
error1 = check_mass_shell (m(i), k(0:,i))
if (error1) then
print *, "O'Mega: panic: particle #", i, "not on-shell"
error = .true.
end if
end do
if (error) then
stop
end if
end subroutine omega_check_momenta_panic
@ \subsection{Obsolete Summation}
\subsubsection{Spin/Helicity Summation}
<<Declaration of obsolete utility functions>>=
public :: omega_sum, omega_sum_nonzero, omega_nonzero
private :: state_index
@
<<Implementation of obsolete utility functions>>=
pure function omega_sum (omega, p, states, fixed) result (sigma)
real(kind=default) :: sigma
real(kind=default), dimension(0:,:), intent(in) :: p
integer, dimension(:), intent(in), optional :: states, fixed
<<[[interface]] for O'Mega Amplitude>>
integer, dimension(size(p,dim=2)) :: s, nstates
integer :: j
complex(kind=default) :: a
if (present (states)) then
nstates = states
else
nstates = 2
end if
sigma = 0
s = -1
sum_spins: do
if (present (fixed)) then
!!! print *, 's = ', s, ', fixed = ', fixed, ', nstates = ', nstates, &
!!! ', fixed|s = ', merge (fixed, s, mask = nstates == 0)
a = omega (p, merge (fixed, s, mask = nstates == 0))
else
a = omega (p, s)
end if
sigma = sigma + a * conjg(a)
<<Step [[s]] like a $n$-ary number and terminate when [[all (s == -1)]]>>
end do sum_spins
sigma = sigma / num_states (2, nstates(1:2))
end function omega_sum
@ We're looping over all spins like a $n$-ary numbers $(-1,\ldots,-1,-1)$,
$(-1,\ldots,-1,0)$, $(-1,\ldots,-1,1)$, $(-1,\ldots,0,-1)$, \ldots,
$(1,\ldots,1,0)$, $(1,\ldots,1,1)$:
<<Step [[s]] like a $n$-ary number and terminate when [[all (s == -1)]]>>=
do j = size (p, dim = 2), 1, -1
select case (nstates (j))
case (3) ! massive vectors
s(j) = modulo (s(j) + 2, 3) - 1
case (2) ! spinors, massless vectors
s(j) = - s(j)
case (1) ! scalars
s(j) = -1
case (0) ! fized spin
s(j) = -1
case default ! ???
s(j) = -1
end select
if (s(j) /= -1) then
cycle sum_spins
end if
end do
exit sum_spins
@ The dual operation evaluates an $n$-number:
<<Implementation of obsolete utility functions>>=
pure function state_index (s, states) result (n)
integer, dimension(:), intent(in) :: s
integer, dimension(:), intent(in), optional :: states
integer :: n
integer :: j, p
n = 1
p = 1
if (present (states)) then
do j = size (s), 1, -1
select case (states(j))
case (3)
n = n + p * (s(j) + 1)
case (2)
n = n + p * (s(j) + 1) / 2
end select
p = p * states(j)
end do
else
do j = size (s), 1, -1
n = n + p * (s(j) + 1) / 2
p = p * 2
end do
end if
end function state_index
@
<<[[interface]] for O'Mega Amplitude>>=
interface
pure function omega (p, s) result (me)
use kinds
implicit none
complex(kind=default) :: me
real(kind=default), dimension(0:,:), intent(in) :: p
integer, dimension(:), intent(in) :: s
end function omega
end interface
@
<<Declaration of obsolete utility functions>>=
public :: num_states
@
<<Implementation of obsolete utility functions>>=
pure function num_states (n, states) result (ns)
integer, intent(in) :: n
integer, dimension(:), intent(in), optional :: states
integer :: ns
if (present (states)) then
ns = product (states, mask = states == 2 .or. states == 3)
else
ns = 2**n
end if
end function num_states
@
\section{\texttt{omega95}}
<<[[omega95.f90]]>>=
<<Copyleft>>
module omega95
use constants
use omega_spinors
use omega_vectors
use omega_polarizations
use omega_tensors
use omega_tensor_polarizations
use omega_couplings
use omega_spinor_couplings
use omega_color
use omega_utils
public
end module omega95
@
\section{\texttt{omega95} Revisited}
<<[[omega95_bispinors.f90]]>>=
<<Copyleft>>
module omega95_bispinors
use constants
use omega_bispinors
use omega_vectors
use omega_vectorspinors
use omega_polarizations
use omega_vspinor_polarizations
use omega_couplings
use omega_bispinor_couplings
use omega_color
use omega_utils
public
end module omega95_bispinors
@
\section{Testing}
<<[[omega_testtools.f90]]>>=
<<Copyleft>>
module omega_testtools
use kinds
implicit none
private
real(kind=default), parameter, private :: THRESHOLD_DEFAULT = 0.6
real(kind=default), parameter, private :: THRESHOLD_WARN = 0.8
<<Declaration of test support functions>>
contains
<<Implementation of test support functions>>
end module omega_testtools
@ Quantify the agreement of two real or complex numbers
\begin{equation}
\text{agreement}(x,y) = \frac{\ln \Delta(x,y)}{\ln\epsilon} \in[0,1]
\end{equation}
with
\begin{equation}
\Delta(x,y) = \frac{|x-y|}{\max(|x|,|y|)}
\end{equation}
and values outside~$[0,1]$ replaced the closed value in the interval.
In other words
\begin{itemize}
\item $1$ for $x-y=\max(|x|,|y|)\cdot\mathcal{O}(\epsilon)$ and
\item $0$~for $x-y=\max(|x|,|y|)\cdot\mathcal{O}(1)$
\end{itemize}
with logarithmic interpolation. The cases~$x=0$ and~$y=0$ must be
treated separately.
<<Declaration of test support functions>>=
public :: agreement
interface agreement
module procedure agreement_real, agreement_complex, &
agreement_real_complex, agreement_complex_real, &
agreement_integer_complex, agreement_complex_integer, &
agreement_integer_real, agreement_real_integer
end interface
private :: agreement_real, agreement_complex, &
agreement_real_complex, agreement_complex_real, &
agreement_integer_complex, agreement_complex_integer, &
agreement_integer_real, agreement_real_integer
@
<<Implementation of test support functions>>=
elemental function agreement_real (x, y, base) result (a)
real(kind=default) :: a
real(kind=default), intent(in) :: x, y
real(kind=default), intent(in), optional :: base
real(kind=default) :: scale, dxy
if (present (base)) then
scale = max (abs (x), abs (y), abs (base))
else
scale = max (abs (x), abs (y))
end if
if (ieee_is_nan (x) .or. ieee_is_nan (y)) then
a = 0
else if (scale <= 0) then
a = -1
else
dxy = abs (x - y) / scale
if (dxy <= 0.0_default) then
a = 1
else
a = log (dxy) / log (epsilon (scale))
a = max (0.0_default, min (1.0_default, a))
if (ieee_is_nan (a)) then
a = 0
end if
end if
end if
if (ieee_is_nan (a)) then
a = 0
end if
end function agreement_real
@ Poor man's replacement
<<Implementation of test support functions>>=
elemental function ieee_is_nan (x) result (yorn)
logical :: yorn
real (kind=default), intent(in) :: x
yorn = (x /= x)
end function ieee_is_nan
@
<<Implementation of test support functions>>=
elemental function agreement_complex (x, y, base) result (a)
real(kind=default) :: a
complex(kind=default), intent(in) :: x, y
real(kind=default), intent(in), optional :: base
real(kind=default) :: scale, dxy
if (present (base)) then
scale = max (abs (x), abs (y), abs (base))
else
scale = max (abs (x), abs (y))
end if
if ( ieee_is_nan (real (x, kind=default)) .or. ieee_is_nan (aimag (x)) &
.or. ieee_is_nan (real (y, kind=default)) .or. ieee_is_nan (aimag (y))) then
a = 0
else if (scale <= 0) then
a = -1
else
dxy = abs (x - y) / scale
if (dxy <= 0.0_default) then
a = 1
else
a = log (dxy) / log (epsilon (scale))
a = max (0.0_default, min (1.0_default, a))
if (ieee_is_nan (a)) then
a = 0
end if
end if
end if
if (ieee_is_nan (a)) then
a = 0
end if
end function agreement_complex
@
<<Implementation of test support functions>>=
elemental function agreement_real_complex (x, y, base) result (a)
real(kind=default) :: a
real(kind=default), intent(in) :: x
complex(kind=default), intent(in) :: y
real(kind=default), intent(in), optional :: base
a = agreement_complex (cmplx (x, kind=default), y, base)
end function agreement_real_complex
@
<<Implementation of test support functions>>=
elemental function agreement_complex_real (x, y, base) result (a)
real(kind=default) :: a
complex(kind=default), intent(in) :: x
real(kind=default), intent(in) :: y
real(kind=default), intent(in), optional :: base
a = agreement_complex (x, cmplx (y, kind=default), base)
end function agreement_complex_real
@
<<Implementation of test support functions>>=
elemental function agreement_integer_complex (x, y, base) result (a)
real(kind=default) :: a
integer, intent(in) :: x
complex(kind=default), intent(in) :: y
real(kind=default), intent(in), optional :: base
a = agreement_complex (cmplx (x, kind=default), y, base)
end function agreement_integer_complex
@
<<Implementation of test support functions>>=
elemental function agreement_complex_integer (x, y, base) result (a)
real(kind=default) :: a
complex(kind=default), intent(in) :: x
integer, intent(in) :: y
real(kind=default), intent(in), optional :: base
a = agreement_complex (x, cmplx (y, kind=default), base)
end function agreement_complex_integer
@
<<Implementation of test support functions>>=
elemental function agreement_integer_real (x, y, base) result (a)
real(kind=default) :: a
integer, intent(in) :: x
real(kind=default), intent(in) :: y
real(kind=default), intent(in), optional :: base
a = agreement_real (real(x, kind=default), y, base)
end function agreement_integer_real
@
<<Implementation of test support functions>>=
elemental function agreement_real_integer (x, y, base) result (a)
real(kind=default) :: a
real(kind=default), intent(in) :: x
integer, intent(in) :: y
real(kind=default), intent(in), optional :: base
a = agreement_real (x, real (y, kind=default), base)
end function agreement_real_integer
@
<<Declaration of test support functions>>=
public:: vanishes
interface vanishes
module procedure vanishes_real, vanishes_complex
end interface
private :: vanishes_real, vanishes_complex
@
<<Implementation of test support functions>>=
elemental function vanishes_real (x, scale) result (a)
real(kind=default) :: a
real(kind=default), intent(in) :: x
real(kind=default), intent(in), optional :: scale
real(kind=default) :: scaled_x
if (x == 0.0_default) then
a = 1
return
else if (ieee_is_nan (x)) then
a = 0
return
end if
scaled_x = x
if (present (scale)) then
if (scale /= 0) then
scaled_x = x / abs (scale)
else
a = 0
return
end if
else
end if
a = log (abs (scaled_x)) / log (epsilon (scaled_x))
a = max (0.0_default, min (1.0_default, a))
if (ieee_is_nan (a)) then
a = 0
end if
end function vanishes_real
@
<<Implementation of test support functions>>=
elemental function vanishes_complex (x, scale) result (a)
real(kind=default) :: a
complex(kind=default), intent(in) :: x
real(kind=default), intent(in), optional :: scale
a = vanishes_real (abs (x), scale)
end function vanishes_complex
@
<<Declaration of test support functions>>=
public :: expect
interface expect
module procedure expect_integer, expect_real, expect_complex, &
expect_real_integer, expect_integer_real, &
expect_complex_integer, expect_integer_complex, &
expect_complex_real, expect_real_complex
end interface
private :: expect_integer, expect_real, expect_complex, &
expect_real_integer, expect_integer_real, &
expect_complex_integer, expect_integer_complex, &
expect_complex_real, expect_real_complex
@
<<Implementation of test support functions>>=
subroutine expect_integer (x, x0, msg, passed, quiet, buffer, unit)
integer, intent(in) :: x, x0
character(len=*), intent(in) :: msg
logical, intent(inout), optional :: passed
logical, intent(in), optional :: quiet
character(len=*), intent(inout), optional :: buffer
integer, intent(in), optional :: unit
logical :: failed, verbose
character(len=*), parameter :: fmt = "(1X,A,': ',A)"
character(len=*), parameter :: &
fmt_verbose = "(1X,A,': ',A,' [expected ',I6,', got ',I6,']')"
failed = .false.
verbose = .true.
if (present (quiet)) then
verbose = .not.quiet
end if
if (x == x0) then
if (verbose) then
if (.not. (present (buffer) .or. present (unit))) then
write (unit = *, fmt = fmt) msg, "passed"
end if
if (present (unit)) then
write (unit = unit, fmt = fmt) msg, "passed"
end if
if (present (buffer)) then
write (unit = buffer, fmt = fmt) msg, "passed"
end if
end if
else
if (.not. (present (buffer) .or. present (unit))) then
write (unit = *, fmt = fmt_verbose) msg, "failed", x0, x
end if
if (present (unit)) then
write (unit = unit, fmt = fmt_verbose) msg, "failed", x0, x
end if
if (present (buffer)) then
write (unit = buffer, fmt = fmt_verbose) msg, "failed", x0, x
end if
failed = .true.
end if
if (present (passed)) then
passed = passed .and. .not.failed
end if
end subroutine expect_integer
@
<<Implementation of test support functions>>=
subroutine expect_real (x, x0, msg, passed, threshold, quiet)
real(kind=default), intent(in) :: x, x0
character(len=*), intent(in) :: msg
logical, intent(inout), optional :: passed
real(kind=default), intent(in), optional :: threshold
logical, intent(in), optional :: quiet
logical :: failed, verbose
real(kind=default) :: agreement_threshold
character(len=*), parameter :: fmt = "(1X,A,': ',A,' at ',I4,'%')"
character(len=*), parameter :: fmt_verbose = "(1X,A,': ',A,' at ',I4,'%'," // &
"' [expected ',E10.3,', got ',E10.3,']')"
real(kind=default) :: a
failed = .false.
verbose = .true.
if (present (quiet)) then
verbose = .not.quiet
end if
if (x == x0) then
if (verbose) then
write (unit = *, fmt = fmt) msg, "passed", 100
end if
else
if (x0 == 0) then
a = vanishes (x)
else
a = agreement (x, x0)
end if
if (present (threshold)) then
agreement_threshold = threshold
else
agreement_threshold = THRESHOLD_DEFAULT
end if
if (a >= agreement_threshold) then
if (verbose) then
if (a >= THRESHOLD_WARN) then
write (unit = *, fmt = fmt) msg, "passed", int (a * 100)
else
write (unit = *, fmt = fmt_verbose) msg, "passed", int (a * 100), x0, x
end if
end if
else
failed = .true.
write (unit = *, fmt = fmt_verbose) msg, "failed", int (a * 100), x0, x
end if
end if
if (present (passed)) then
passed = passed .and. .not.failed
end if
end subroutine expect_real
@
<<Implementation of test support functions>>=
subroutine expect_complex (x, x0, msg, passed, threshold, quiet)
complex(kind=default), intent(in) :: x, x0
character(len=*), intent(in) :: msg
logical, intent(inout), optional :: passed
real(kind=default), intent(in), optional :: threshold
logical, intent(in), optional :: quiet
logical :: failed, verbose
real(kind=default) :: agreement_threshold
character(len=*), parameter :: fmt = "(1X,A,': ',A,' at ',I4,'%')"
character(len=*), parameter :: fmt_verbose = "(1X,A,': ',A,' at ',I4,'%'," // &
"' [expected (',E10.3,',',E10.3,'), got (',E10.3,',',E10.3,')]')"
character(len=*), parameter :: fmt_phase = "(1X,A,': ',A,' at ',I4,'%'," // &
"' [modulus passed at ',I4,'%',', phases ',F5.3,' vs. ',F5.3,']')"
real(kind=default) :: a, a_modulus
failed = .false.
verbose = .true.
if (present (quiet)) then
verbose = .not.quiet
end if
if (x == x0) then
if (verbose) then
write (unit = *, fmt = fmt) msg, "passed", 100
end if
else
if (x0 == 0) then
a = vanishes (x)
else
a = agreement (x, x0)
end if
if (present (threshold)) then
agreement_threshold = threshold
else
agreement_threshold = THRESHOLD_DEFAULT
end if
if (a >= agreement_threshold) then
if (verbose) then
if (a >= THRESHOLD_WARN) then
write (unit = *, fmt = fmt) msg, "passed", int (a * 100)
else
write (unit = *, fmt = fmt_verbose) msg, "passed", int (a * 100), x0, x
end if
end if
else
a_modulus = agreement (abs (x), abs (x0))
if (a_modulus >= agreement_threshold) then
write (unit = *, fmt = fmt_phase) msg, "failed", int (a * 100), &
int (a_modulus * 100), &
atan2 (real (x, kind=default), aimag (x)), &
atan2 (real (x0, kind=default), aimag (x0))
else
write (unit = *, fmt = fmt_verbose) msg, "failed", int (a * 100), x0, x
end if
failed = .true.
end if
end if
if (present (passed)) then
passed = passed .and. .not.failed
end if
end subroutine expect_complex
@
<<Implementation of test support functions>>=
subroutine expect_real_integer (x, x0, msg, passed, threshold, quiet)
real(kind=default), intent(in) :: x
integer, intent(in) :: x0
character(len=*), intent(in) :: msg
real(kind=default), intent(in), optional :: threshold
logical, intent(inout), optional :: passed
logical, intent(in), optional :: quiet
call expect_real (x, real (x0, kind=default), msg, passed, threshold, quiet)
end subroutine expect_real_integer
@
<<Implementation of test support functions>>=
subroutine expect_integer_real (x, x0, msg, passed, threshold, quiet)
integer, intent(in) :: x
real(kind=default), intent(in) :: x0
character(len=*), intent(in) :: msg
real(kind=default), intent(in), optional :: threshold
logical, intent(inout), optional :: passed
logical, intent(in), optional :: quiet
call expect_real (real (x, kind=default), x0, msg, passed, threshold, quiet)
end subroutine expect_integer_real
@
<<Implementation of test support functions>>=
subroutine expect_complex_integer (x, x0, msg, passed, threshold, quiet)
complex(kind=default), intent(in) :: x
integer, intent(in) :: x0
character(len=*), intent(in) :: msg
logical, intent(inout), optional :: passed
real(kind=default), intent(in), optional :: threshold
logical, intent(in), optional :: quiet
call expect_complex (x, cmplx (x0, kind=default), msg, passed, threshold, quiet)
end subroutine expect_complex_integer
@
<<Implementation of test support functions>>=
subroutine expect_integer_complex (x, x0, msg, passed, threshold, quiet)
integer, intent(in) :: x
complex(kind=default), intent(in) :: x0
character(len=*), intent(in) :: msg
logical, intent(inout), optional :: passed
real(kind=default), intent(in), optional :: threshold
logical, intent(in), optional :: quiet
call expect_complex (cmplx (x, kind=default), x0, msg, passed, threshold, quiet)
end subroutine expect_integer_complex
@
<<Implementation of test support functions>>=
subroutine expect_complex_real (x, x0, msg, passed, threshold, quiet)
complex(kind=default), intent(in) :: x
real(kind=default), intent(in) :: x0
character(len=*), intent(in) :: msg
logical, intent(inout), optional :: passed
real(kind=default), intent(in), optional :: threshold
logical, intent(in), optional :: quiet
call expect_complex (x, cmplx (x0, kind=default), msg, passed, threshold, quiet)
end subroutine expect_complex_real
@
<<Implementation of test support functions>>=
subroutine expect_real_complex (x, x0, msg, passed, threshold, quiet)
real(kind=default), intent(in) :: x
complex(kind=default), intent(in) :: x0
character(len=*), intent(in) :: msg
logical, intent(inout), optional :: passed
real(kind=default), intent(in), optional :: threshold
logical, intent(in), optional :: quiet
call expect_complex (cmplx (x, kind=default), x0, msg, passed, threshold, quiet)
end subroutine expect_real_complex
@
<<Declaration of test support functions>>=
public :: expect_zero
interface expect_zero
module procedure expect_zero_integer, expect_zero_real, expect_zero_complex
end interface
private :: expect_zero_integer, expect_zero_real, expect_zero_complex
@
<<Implementation of test support functions>>=
subroutine expect_zero_integer (x, msg, passed)
integer, intent(in) :: x
character(len=*), intent(in) :: msg
logical, intent(inout), optional :: passed
call expect_integer (x, 0, msg, passed)
end subroutine expect_zero_integer
@
<<Implementation of test support functions>>=
subroutine expect_zero_real (x, scale, msg, passed, threshold, quiet)
real(kind=default), intent(in) :: x, scale
character(len=*), intent(in) :: msg
logical, intent(inout), optional :: passed
real(kind=default), intent(in), optional :: threshold
logical, intent(in), optional :: quiet
logical :: failed, verbose
real(kind=default) :: agreement_threshold
character(len=*), parameter :: fmt = "(1X,A,': ',A,' at ',I4,'%')"
character(len=*), parameter :: fmt_verbose = "(1X,A,': ',A,' at ',I4,'%'," // &
"' [expected 0 (relative to ',E10.3,') got ',E10.3,']')"
real(kind=default) :: a
failed = .false.
verbose = .true.
if (present (quiet)) then
verbose = .not.quiet
end if
if (x == 0) then
if (verbose) then
write (unit = *, fmt = fmt) msg, "passed", 100
end if
else
a = vanishes (x, scale = scale)
if (present (threshold)) then
agreement_threshold = threshold
else
agreement_threshold = THRESHOLD_DEFAULT
end if
if (a >= agreement_threshold) then
if (verbose) then
if (a >= THRESHOLD_WARN) then
write (unit = *, fmt = fmt) msg, "passed", int (a * 100)
else
write (unit = *, fmt = fmt_verbose) msg, "passed", int (a * 100), scale, x
end if
end if
else
failed = .true.
write (unit = *, fmt = fmt_verbose) msg, "failed", int (a * 100), scale, x
end if
end if
if (present (passed)) then
passed = passed .and. .not.failed
end if
end subroutine expect_zero_real
@
<<Implementation of test support functions>>=
subroutine expect_zero_complex (x, scale, msg, passed, threshold, quiet)
complex(kind=default), intent(in) :: x
real(kind=default), intent(in) :: scale
character(len=*), intent(in) :: msg
logical, intent(inout), optional :: passed
real(kind=default), intent(in), optional :: threshold
logical, intent(in), optional :: quiet
call expect_zero_real (abs (x), scale, msg, passed, threshold, quiet)
end subroutine expect_zero_complex
@
<<Implementation of test support functions>>=
subroutine print_matrix (a)
complex(kind=default), dimension(:,:), intent(in) :: a
integer :: row
do row = 1, size (a, dim=1)
write (unit = *, fmt = "(10(tr2, f5.2, '+', f5.2, 'I'))") a(row,:)
end do
end subroutine print_matrix
@
<<Declaration of test support functions>>=
public :: print_matrix
@
<<[[test_omega95.f90]]>>=
<<Copyleft>>
program test_omega95
use kinds
use omega95
use omega_testtools
implicit none
real(kind=default) :: m, pabs, qabs, w
real(kind=default), dimension(0:3) :: r
complex(kind=default) :: c_one, c_nil
type(momentum) :: p, q, p0
type(vector) :: vp, vq, vtest, v0
type(tensor) :: ttest
integer, dimension(8) :: date_time
integer :: rsize
logical :: passed
call date_and_time (values = date_time)
call random_seed (size = rsize)
call random_seed (put = spread (product (date_time), dim = 1, ncopies = rsize))
w = 1.4142
c_one = 1.0_default
c_nil = 0.0_default
m = 13
pabs = 42
qabs = 137
call random_number (r)
vtest%t = cmplx (10.0_default * r(0), kind=default)
vtest%x(1:3) = cmplx (10.0_default * r(1:3), kind=default)
ttest = vtest.tprod.vtest
call random_momentum (p, pabs, m)
call random_momentum (q, qabs, m)
call random_momentum (p0, 0.0_default, m)
vp = p
vq = q
v0 = p0
passed = .true.
<<Test [[omega95]]>>
if (.not. passed) then
stop 1
end if
end program test_omega95
@
<<Test [[omega95]]>>=
print *, "*** Checking the equations of motion ***:"
call expect (abs(f_vf(c_one,vp,u(m,p,+1))-m*u(m,p,+1)), 0, "|[p-m]u(+)|=0", passed)
call expect (abs(f_vf(c_one,vp,u(m,p,-1))-m*u(m,p,-1)), 0, "|[p-m]u(-)|=0", passed)
call expect (abs(f_vf(c_one,vp,v(m,p,+1))+m*v(m,p,+1)), 0, "|[p+m]v(+)|=0", passed)
call expect (abs(f_vf(c_one,vp,v(m,p,-1))+m*v(m,p,-1)), 0, "|[p+m]v(-)|=0", passed)
call expect (abs(f_fv(c_one,ubar(m,p,+1),vp)-m*ubar(m,p,+1)), 0, "|ubar(+)[p-m]|=0", passed)
call expect (abs(f_fv(c_one,ubar(m,p,-1),vp)-m*ubar(m,p,-1)), 0, "|ubar(-)[p-m]|=0", passed)
call expect (abs(f_fv(c_one,vbar(m,p,+1),vp)+m*vbar(m,p,+1)), 0, "|vbar(+)[p+m]|=0", passed)
call expect (abs(f_fv(c_one,vbar(m,p,-1),vp)+m*vbar(m,p,-1)), 0, "|vbar(-)[p+m]|=0", passed)
print *, "*** Checking the equations of motion for negative mass***:"
call expect (abs(f_vf(c_one,vp,u(-m,p,+1))+m*u(-m,p,+1)), 0, "|[p+m]u(+)|=0", passed)
call expect (abs(f_vf(c_one,vp,u(-m,p,-1))+m*u(-m,p,-1)), 0, "|[p+m]u(-)|=0", passed)
call expect (abs(f_vf(c_one,vp,v(-m,p,+1))-m*v(-m,p,+1)), 0, "|[p-m]v(+)|=0", passed)
call expect (abs(f_vf(c_one,vp,v(-m,p,-1))-m*v(-m,p,-1)), 0, "|[p-m]v(-)|=0", passed)
call expect (abs(f_fv(c_one,ubar(-m,p,+1),vp)+m*ubar(-m,p,+1)), 0, "|ubar(+)[p+m]|=0", passed)
call expect (abs(f_fv(c_one,ubar(-m,p,-1),vp)+m*ubar(-m,p,-1)), 0, "|ubar(-)[p+m]|=0", passed)
call expect (abs(f_fv(c_one,vbar(-m,p,+1),vp)-m*vbar(-m,p,+1)), 0, "|vbar(+)[p-m]|=0", passed)
call expect (abs(f_fv(c_one,vbar(-m,p,-1),vp)-m*vbar(-m,p,-1)), 0, "|vbar(-)[p-m]|=0", passed)
@
<<Test [[omega95]]>>=
print *, "*** Checking the normalization ***:"
call expect (ubar(m,p,+1)*u(m,p,+1), +2*m, "ubar(+)*u(+)=+2m", passed)
call expect (ubar(m,p,-1)*u(m,p,-1), +2*m, "ubar(-)*u(-)=+2m", passed)
call expect (vbar(m,p,+1)*v(m,p,+1), -2*m, "vbar(+)*v(+)=-2m", passed)
call expect (vbar(m,p,-1)*v(m,p,-1), -2*m, "vbar(-)*v(-)=-2m", passed)
call expect (ubar(m,p,+1)*v(m,p,+1), 0, "ubar(+)*v(+)=0 ", passed)
call expect (ubar(m,p,-1)*v(m,p,-1), 0, "ubar(-)*v(-)=0 ", passed)
call expect (vbar(m,p,+1)*u(m,p,+1), 0, "vbar(+)*u(+)=0 ", passed)
call expect (vbar(m,p,-1)*u(m,p,-1), 0, "vbar(-)*u(-)=0 ", passed)
print *, "*** Checking the normalization for negative masses***:"
call expect (ubar(-m,p,+1)*u(-m,p,+1), -2*m, "ubar(+)*u(+)=-2m", passed)
call expect (ubar(-m,p,-1)*u(-m,p,-1), -2*m, "ubar(-)*u(-)=-2m", passed)
call expect (vbar(-m,p,+1)*v(-m,p,+1), +2*m, "vbar(+)*v(+)=+2m", passed)
call expect (vbar(-m,p,-1)*v(-m,p,-1), +2*m, "vbar(-)*v(-)=+2m", passed)
call expect (ubar(-m,p,+1)*v(-m,p,+1), 0, "ubar(+)*v(+)=0 ", passed)
call expect (ubar(-m,p,-1)*v(-m,p,-1), 0, "ubar(-)*v(-)=0 ", passed)
call expect (vbar(-m,p,+1)*u(-m,p,+1), 0, "vbar(+)*u(+)=0 ", passed)
call expect (vbar(-m,p,-1)*u(-m,p,-1), 0, "vbar(-)*u(-)=0 ", passed)
@
<<Test [[omega95]]>>=
print *, "*** Checking the currents ***:"
call expect (abs(v_ff(c_one,ubar(m,p,+1),u(m,p,+1))-2*vp), 0, "ubar(+).V.u(+)=2p", passed)
call expect (abs(v_ff(c_one,ubar(m,p,-1),u(m,p,-1))-2*vp), 0, "ubar(-).V.u(-)=2p", passed)
call expect (abs(v_ff(c_one,vbar(m,p,+1),v(m,p,+1))-2*vp), 0, "vbar(+).V.v(+)=2p", passed)
call expect (abs(v_ff(c_one,vbar(m,p,-1),v(m,p,-1))-2*vp), 0, "vbar(-).V.v(-)=2p", passed)
print *, "*** Checking the currents for negative masses***:"
call expect (abs(v_ff(c_one,ubar(-m,p,+1),u(-m,p,+1))-2*vp), 0, "ubar(+).V.u(+)=2p", passed)
call expect (abs(v_ff(c_one,ubar(-m,p,-1),u(-m,p,-1))-2*vp), 0, "ubar(-).V.u(-)=2p", passed)
call expect (abs(v_ff(c_one,vbar(-m,p,+1),v(-m,p,+1))-2*vp), 0, "vbar(+).V.v(+)=2p", passed)
call expect (abs(v_ff(c_one,vbar(-m,p,-1),v(-m,p,-1))-2*vp), 0, "vbar(-).V.v(-)=2p", passed)
@
<<Test [[omega95]]>>=
print *, "*** Checking current conservation ***:"
call expect ((vp-vq)*v_ff(c_one,ubar(m,p,+1),u(m,q,+1)), 0, "d(ubar(+).V.u(+))=0", passed)
call expect ((vp-vq)*v_ff(c_one,ubar(m,p,-1),u(m,q,-1)), 0, "d(ubar(-).V.u(-))=0", passed)
call expect ((vp-vq)*v_ff(c_one,vbar(m,p,+1),v(m,q,+1)), 0, "d(vbar(+).V.v(+))=0", passed)
call expect ((vp-vq)*v_ff(c_one,vbar(m,p,-1),v(m,q,-1)), 0, "d(vbar(-).V.v(-))=0", passed)
print *, "*** Checking current conservation for negative masses***:"
call expect ((vp-vq)*v_ff(c_one,ubar(-m,p,+1),u(-m,q,+1)), 0, "d(ubar(+).V.u(+))=0", passed)
call expect ((vp-vq)*v_ff(c_one,ubar(-m,p,-1),u(-m,q,-1)), 0, "d(ubar(-).V.u(-))=0", passed)
call expect ((vp-vq)*v_ff(c_one,vbar(-m,p,+1),v(-m,q,+1)), 0, "d(vbar(+).V.v(+))=0", passed)
call expect ((vp-vq)*v_ff(c_one,vbar(-m,p,-1),v(-m,q,-1)), 0, "d(vbar(-).V.v(-))=0", passed)
@
<<Test [[omega95]]>>=
if (m == 0) then
print *, "*** Checking axial current conservation ***:"
call expect ((vp-vq)*a_ff(c_one,ubar(m,p,+1),u(m,q,+1)), 0, "d(ubar(+).A.u(+))=0", passed)
call expect ((vp-vq)*a_ff(c_one,ubar(m,p,-1),u(m,q,-1)), 0, "d(ubar(-).A.u(-))=0", passed)
call expect ((vp-vq)*a_ff(c_one,vbar(m,p,+1),v(m,q,+1)), 0, "d(vbar(+).A.v(+))=0", passed)
call expect ((vp-vq)*a_ff(c_one,vbar(m,p,-1),v(m,q,-1)), 0, "d(vbar(-).A.v(-))=0", passed)
end if
@
<<Test [[omega95]]>>=
print *, "*** Checking implementation of the sigma vertex funktions ***:"
call expect ((vp*tvam_ff(c_one,c_nil,ubar(m,p,+1),u(m,q,+1),q) - (p*q-m**2)*(ubar(m,p,+1)*u(m,q,+1))), 0, &
"p*[ubar(p,+).(Isigma*q).u(q,+)] - (p*q-m^2)*ubar(p,+).u(q,+) = 0", passed)
call expect ((vp*tvam_ff(c_one,c_nil,ubar(m,p,-1),u(m,q,-1),q) - (p*q-m**2)*(ubar(m,p,-1)*u(m,q,-1))), 0, &
"p*[ubar(p,-).(Isigma*q).u(q,-)] - (p*q-m^2)*ubar(p,-).u(q,-) = 0", passed)
call expect ((vp*tvam_ff(c_one,c_nil,vbar(m,p,+1),v(m,q,+1),q) - (p*q-m**2)*(vbar(m,p,+1)*v(m,q,+1))), 0, &
"p*[vbar(p,+).(Isigma*q).v(q,+)] - (p*q-m^2)*vbar(p,+).v(q,+) = 0", passed)
call expect ((vp*tvam_ff(c_one,c_nil,vbar(m,p,-1),v(m,q,-1),q) - (p*q-m**2)*(vbar(m,p,-1)*v(m,q,-1))), 0, &
"p*[vbar(p,-).(Isigma*q).v(q,-)] - (p*q-m^2)*vbar(p,-).v(q,-) = 0", passed)
call expect ((ubar(m,p,+1)*f_tvamf(c_one,c_nil,vp,u(m,q,+1),q) - (p*q-m**2)*(ubar(m,p,+1)*u(m,q,+1))), 0, &
"ubar(p,+).[p*(Isigma*q).u(q,+)] - (p*q-m^2)*ubar(p,+).u(q,+) = 0", passed)
call expect ((ubar(m,p,-1)*f_tvamf(c_one,c_nil,vp,u(m,q,-1),q) - (p*q-m**2)*(ubar(m,p,-1)*u(m,q,-1))), 0, &
"ubar(p,-).[p*(Isigma*q).u(q,-)] - (p*q-m^2)*ubar(p,-).u(q,-) = 0", passed)
call expect ((vbar(m,p,+1)*f_tvamf(c_one,c_nil,vp,v(m,q,+1),q) - (p*q-m**2)*(vbar(m,p,+1)*v(m,q,+1))), 0, &
"vbar(p,+).[p*(Isigma*q).v(q,+)] - (p*q-m^2)*vbar(p,+).v(q,+) = 0", passed)
call expect ((vbar(m,p,-1)*f_tvamf(c_one,c_nil,vp,v(m,q,-1),q) - (p*q-m**2)*(vbar(m,p,-1)*v(m,q,-1))), 0, &
"vbar(p,-).[p*(Isigma*q).v(q,-)] - (p*q-m^2)*vbar(p,-).v(q,-) = 0", passed)
call expect ((f_ftvam(c_one,c_nil,ubar(m,p,+1),vp,q)*u(m,q,+1) - (p*q-m**2)*(ubar(m,p,+1)*u(m,q,+1))), 0, &
"[ubar(p,+).p*(Isigma*q)].u(q,+) - (p*q-m^2)*ubar(p,+).u(q,+) = 0", passed)
call expect ((f_ftvam(c_one,c_nil,ubar(m,p,-1),vp,q)*u(m,q,-1) - (p*q-m**2)*(ubar(m,p,-1)*u(m,q,-1))), 0, &
"[ubar(p,-).p*(Isigma*q)].u(q,-) - (p*q-m^2)*ubar(p,-).u(q,-) = 0", passed)
call expect ((f_ftvam(c_one,c_nil,vbar(m,p,+1),vp,q)*v(m,q,+1) - (p*q-m**2)*(vbar(m,p,+1)*v(m,q,+1))), 0, &
"[vbar(p,+).p*(Isigma*q)].v(q,+) - (p*q-m^2)*vbar(p,+).v(q,+) = 0", passed)
call expect ((f_ftvam(c_one,c_nil,vbar(m,p,-1),vp,q)*v(m,q,-1) - (p*q-m**2)*(vbar(m,p,-1)*v(m,q,-1))), 0, &
"[vbar(p,-).p*(Isigma*q)].v(q,-) - (p*q-m^2)*vbar(p,-).v(q,-) = 0", passed)
call expect ((vp*tvam_ff(c_nil,c_one,ubar(m,p,+1),u(m,q,+1),q) - (p*q+m**2)*p_ff(c_one,ubar(m,p,+1),u(m,q,+1))), 0, &
"p*[ubar(p,+).(Isigma*q).g5.u(q,+)] - (p*q+m^2)*ubar(p,+).g5.u(q,+) = 0", passed)
call expect ((vp*tvam_ff(c_nil,c_one,ubar(m,p,-1),u(m,q,-1),q) - (p*q+m**2)*p_ff(c_one,ubar(m,p,-1),u(m,q,-1))), 0, &
"p*[ubar(p,-).(Isigma*q).g5.u(q,-)] - (p*q+m^2)*ubar(p,-).g5.u(q,-) = 0", passed)
call expect ((vp*tvam_ff(c_nil,c_one,vbar(m,p,+1),v(m,q,+1),q) - (p*q+m**2)*p_ff(c_one,vbar(m,p,+1),v(m,q,+1))), 0, &
"p*[vbar(p,+).(Isigma*q).g5.v(q,+)] - (p*q+m^2)*vbar(p,+).g5.v(q,+) = 0", passed)
call expect ((vp*tvam_ff(c_nil,c_one,vbar(m,p,-1),v(m,q,-1),q) - (p*q+m**2)*p_ff(c_one,vbar(m,p,-1),v(m,q,-1))), 0, &
"p*[vbar(p,-).(Isigma*q).g5.v(q,-)] - (p*q+m^2)*vbar(p,-).g5.v(q,-) = 0", passed)
call expect ((ubar(m,p,+1)*f_tvamf(c_nil,c_one,vp,u(m,q,+1),q) - (p*q+m**2)*p_ff(c_one,ubar(m,p,+1),u(m,q,+1))), 0, &
"p*[ubar(p,+).(Isigma*q).g5.u(q,+)] - (p*q+m^2)*ubar(p,+).g5.u(q,+) = 0", passed)
call expect ((ubar(m,p,-1)*f_tvamf(c_nil,c_one,vp,u(m,q,-1),q) - (p*q+m**2)*p_ff(c_one,ubar(m,p,-1),u(m,q,-1))), 0, &
"p*[ubar(p,-).(Isigma*q).g5.u(q,-)] - (p*q+m^2)*ubar(p,-).g5.u(q,-) = 0", passed)
call expect ((vbar(m,p,+1)*f_tvamf(c_nil,c_one,vp,v(m,q,+1),q) - (p*q+m**2)*p_ff(c_one,vbar(m,p,+1),v(m,q,+1))), 0, &
"p*[vbar(p,+).(Isigma*q).g5.v(q,+)] - (p*q+m^2)*vbar(p,+).g5.v(q,+) = 0", passed)
call expect ((vbar(m,p,-1)*f_tvamf(c_nil,c_one,vp,v(m,q,-1),q) - (p*q+m**2)*p_ff(c_one,vbar(m,p,-1),v(m,q,-1))), 0, &
"p*[vbar(p,-).(Isigma*q).g5.v(q,-)] - (p*q+m^2)*vbar(p,-).g5.v(q,-) = 0", passed)
call expect ((f_ftvam(c_nil,c_one,ubar(m,p,+1),vp,q)*u(m,q,+1) - (p*q+m**2)*p_ff(c_one,ubar(m,p,+1),u(m,q,+1))), 0, &
"p*[ubar(p,+).(Isigma*q).g5.u(q,+)] - (p*q+m^2)*ubar(p,+).g5.u(q,+) = 0", passed)
call expect ((f_ftvam(c_nil,c_one,ubar(m,p,-1),vp,q)*u(m,q,-1) - (p*q+m**2)*p_ff(c_one,ubar(m,p,-1),u(m,q,-1))), 0, &
"p*[ubar(p,-).(Isigma*q).g5.u(q,-)] - (p*q+m^2)*ubar(p,-).g5.u(q,-) = 0", passed)
call expect ((f_ftvam(c_nil,c_one,vbar(m,p,+1),vp,q)*v(m,q,+1) - (p*q+m**2)*p_ff(c_one,vbar(m,p,+1),v(m,q,+1))), 0, &
"p*[vbar(p,+).(Isigma*q).g5.v(q,+)] - (p*q+m^2)*vbar(p,+).g5.v(q,+) = 0", passed)
call expect ((f_ftvam(c_nil,c_one,vbar(m,p,-1),vp,q)*v(m,q,-1) - (p*q+m**2)*p_ff(c_one,vbar(m,p,-1),v(m,q,-1))), 0, &
"p*[vbar(p,-).(Isigma*q).g5.v(q,-)] - (p*q+m^2)*vbar(p,-).g5.v(q,-) = 0", passed)
@
<<Test [[omega95]]>>=
print *, "*** Checking polarisation vectors: ***"
call expect (conjg(eps(m,p, 1))*eps(m,p, 1), -1, "e( 1).e( 1)=-1", passed)
call expect (conjg(eps(m,p, 1))*eps(m,p,-1), 0, "e( 1).e(-1)= 0", passed)
call expect (conjg(eps(m,p,-1))*eps(m,p, 1), 0, "e(-1).e( 1)= 0", passed)
call expect (conjg(eps(m,p,-1))*eps(m,p,-1), -1, "e(-1).e(-1)=-1", passed)
call expect ( p*eps(m,p, 1), 0, " p.e( 1)= 0", passed)
call expect ( p*eps(m,p,-1), 0, " p.e(-1)= 0", passed)
if (m > 0) then
call expect (conjg(eps(m,p, 1))*eps(m,p, 0), 0, "e( 1).e( 0)= 0", passed)
call expect (conjg(eps(m,p, 0))*eps(m,p, 1), 0, "e( 0).e( 1)= 0", passed)
call expect (conjg(eps(m,p, 0))*eps(m,p, 0), -1, "e( 0).e( 0)=-1", passed)
call expect (conjg(eps(m,p, 0))*eps(m,p,-1), 0, "e( 0).e(-1)= 0", passed)
call expect (conjg(eps(m,p,-1))*eps(m,p, 0), 0, "e(-1).e( 0)= 0", passed)
call expect ( p*eps(m,p, 0), 0, " p.e( 0)= 0", passed)
end if
@
<<Test [[omega95]]>>=
print *, "*** Checking epsilon tensor: ***"
call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), &
- pseudo_scalar(eps(m,q,1),eps(m,p,1),eps(m,p,0),eps(m,q,0)), "eps(1<->2)", passed)
call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), &
- pseudo_scalar(eps(m,p,0),eps(m,q,1),eps(m,p,1),eps(m,q,0)), "eps(1<->3)", passed)
call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), &
- pseudo_scalar(eps(m,q,0),eps(m,q,1),eps(m,p,0),eps(m,p,1)), "eps(1<->4)", passed)
call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), &
- pseudo_scalar(eps(m,p,1),eps(m,p,0),eps(m,q,1),eps(m,q,0)), "eps(2<->3)", passed)
call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), &
- pseudo_scalar(eps(m,p,1),eps(m,q,0),eps(m,p,0),eps(m,q,1)), "eps(2<->4)", passed)
call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), &
- pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,q,0),eps(m,p,0)), "eps(3<->4)", passed)
call expect ( pseudo_scalar(eps(m,p,1),eps(m,q,1),eps(m,p,0),eps(m,q,0)), &
eps(m,p,1)*pseudo_vector(eps(m,q,1),eps(m,p,0),eps(m,q,0)), "eps'", passed)
@
\begin{equation}
\frac{1}{2} [x\wedge y]^*_{\mu\nu} [x\wedge y]^{\mu\nu}
= \frac{1}{2} (x^*_\mu y^*_\nu-x^*_\nu y^*_\mu) (x^\mu y^\nu-x^\nu y^\mu)
= (x^*x) (y^*y) - (x^*y) (y^*x)
\end{equation}
<<Test [[omega95]]>>=
print *, "*** Checking tensors: ***"
call expect (conjg(p.wedge.q)*(p.wedge.q), (p*p)*(q*q)-(p*q)**2, &
"[p,q].[q,p]=p.p*q.q-p.q^2", passed)
call expect (conjg(p.wedge.q)*(q.wedge.p), (p*q)**2-(p*p)*(q*q), &
"[p,q].[q,p]=p.q^2-p.p*q.q", passed)
@ i.\,e.
\begin{equation}
\frac{1}{2} [p\wedge\epsilon(p,i)]^*_{\mu\nu} [p\wedge\epsilon(p,j)]^{\mu\nu}
= - p^2 \delta_{ij}
\end{equation}
<<Test [[omega95]]>>=
call expect (conjg(p.wedge.eps(m,p, 1))*(p.wedge.eps(m,p, 1)), -p*p, &
"[p,e( 1)].[p,e( 1)]=-p.p", passed)
call expect (conjg(p.wedge.eps(m,p, 1))*(p.wedge.eps(m,p,-1)), 0, &
"[p,e( 1)].[p,e(-1)]=0", passed)
call expect (conjg(p.wedge.eps(m,p,-1))*(p.wedge.eps(m,p, 1)), 0, &
"[p,e(-1)].[p,e( 1)]=0", passed)
call expect (conjg(p.wedge.eps(m,p,-1))*(p.wedge.eps(m,p,-1)), -p*p, &
"[p,e(-1)].[p,e(-1)]=-p.p", passed)
if (m > 0) then
call expect (conjg(p.wedge.eps(m,p, 1))*(p.wedge.eps(m,p, 0)), 0, &
"[p,e( 1)].[p,e( 0)]=0", passed)
call expect (conjg(p.wedge.eps(m,p, 0))*(p.wedge.eps(m,p, 1)), 0, &
"[p,e( 0)].[p,e( 1)]=0", passed)
call expect (conjg(p.wedge.eps(m,p, 0))*(p.wedge.eps(m,p, 0)), -p*p, &
"[p,e( 0)].[p,e( 0)]=-p.p", passed)
call expect (conjg(p.wedge.eps(m,p, 0))*(p.wedge.eps(m,p,-1)), 0, &
"[p,e( 1)].[p,e(-1)]=0", passed)
call expect (conjg(p.wedge.eps(m,p,-1))*(p.wedge.eps(m,p, 0)), 0, &
"[p,e(-1)].[p,e( 0)]=0", passed)
end if
@ also
\begin{align}
[x\wedge y]_{\mu\nu} z^\nu &= x_\mu (yz) - y_\mu (xz) \\
z_\mu [x\wedge y]^{\mu\nu} &= (zx) y^\nu - (zy) x^\nu
\end{align}
<<Test [[omega95]]>>=
call expect (abs ((p.wedge.eps(m,p, 1))*p + (p*p)*eps(m,p, 1)), 0, &
"[p,e( 1)].p=-p.p*e( 1)]", passed)
call expect (abs ((p.wedge.eps(m,p, 0))*p + (p*p)*eps(m,p, 0)), 0, &
"[p,e( 0)].p=-p.p*e( 0)]", passed)
call expect (abs ((p.wedge.eps(m,p,-1))*p + (p*p)*eps(m,p,-1)), 0, &
"[p,e(-1)].p=-p.p*e(-1)]", passed)
call expect (abs (p*(p.wedge.eps(m,p, 1)) - (p*p)*eps(m,p, 1)), 0, &
"p.[p,e( 1)]=p.p*e( 1)]", passed)
call expect (abs (p*(p.wedge.eps(m,p, 0)) - (p*p)*eps(m,p, 0)), 0, &
"p.[p,e( 0)]=p.p*e( 0)]", passed)
call expect (abs (p*(p.wedge.eps(m,p,-1)) - (p*p)*eps(m,p,-1)), 0, &
"p.[p,e(-1)]=p.p*e(-1)]", passed)
@
<<Test [[omega95]]>>=
print *, "*** Checking polarisation tensors: ***"
call expect (conjg(eps2(m,p, 2))*eps2(m,p, 2), 1, "e2( 2).e2( 2)=1", passed)
call expect (conjg(eps2(m,p, 2))*eps2(m,p,-2), 0, "e2( 2).e2(-2)=0", passed)
call expect (conjg(eps2(m,p,-2))*eps2(m,p, 2), 0, "e2(-2).e2( 2)=0", passed)
call expect (conjg(eps2(m,p,-2))*eps2(m,p,-2), 1, "e2(-2).e2(-2)=1", passed)
if (m > 0) then
call expect (conjg(eps2(m,p, 2))*eps2(m,p, 1), 0, "e2( 2).e2( 1)=0", passed)
call expect (conjg(eps2(m,p, 2))*eps2(m,p, 0), 0, "e2( 2).e2( 0)=0", passed)
call expect (conjg(eps2(m,p, 2))*eps2(m,p,-1), 0, "e2( 2).e2(-1)=0", passed)
call expect (conjg(eps2(m,p, 1))*eps2(m,p, 2), 0, "e2( 1).e2( 2)=0", passed)
call expect (conjg(eps2(m,p, 1))*eps2(m,p, 1), 1, "e2( 1).e2( 1)=1", passed)
call expect (conjg(eps2(m,p, 1))*eps2(m,p, 0), 0, "e2( 1).e2( 0)=0", passed)
call expect (conjg(eps2(m,p, 1))*eps2(m,p,-1), 0, "e2( 1).e2(-1)=0", passed)
call expect (conjg(eps2(m,p, 1))*eps2(m,p,-2), 0, "e2( 1).e2(-2)=0", passed)
call expect (conjg(eps2(m,p, 0))*eps2(m,p, 2), 0, "e2( 0).e2( 2)=0", passed)
call expect (conjg(eps2(m,p, 0))*eps2(m,p, 1), 0, "e2( 0).e2( 1)=0", passed)
call expect (conjg(eps2(m,p, 0))*eps2(m,p, 0), 1, "e2( 0).e2( 0)=1", passed)
call expect (conjg(eps2(m,p, 0))*eps2(m,p,-1), 0, "e2( 0).e2(-1)=0", passed)
call expect (conjg(eps2(m,p, 0))*eps2(m,p,-2), 0, "e2( 0).e2(-2)=0", passed)
call expect (conjg(eps2(m,p,-1))*eps2(m,p, 2), 0, "e2(-1).e2( 2)=0", passed)
call expect (conjg(eps2(m,p,-1))*eps2(m,p, 1), 0, "e2(-1).e2( 1)=0", passed)
call expect (conjg(eps2(m,p,-1))*eps2(m,p, 0), 0, "e2(-1).e2( 0)=0", passed)
call expect (conjg(eps2(m,p,-1))*eps2(m,p,-1), 1, "e2(-1).e2(-1)=1", passed)
call expect (conjg(eps2(m,p,-1))*eps2(m,p,-2), 0, "e2(-1).e2(-2)=0", passed)
call expect (conjg(eps2(m,p,-2))*eps2(m,p, 1), 0, "e2(-2).e2( 1)=0", passed)
call expect (conjg(eps2(m,p,-2))*eps2(m,p, 0), 0, "e2(-2).e2( 0)=0", passed)
call expect (conjg(eps2(m,p,-2))*eps2(m,p,-1), 0, "e2(-2).e2(-1)=0", passed)
end if
@
<<Test [[omega95]]>>=
call expect ( abs(p*eps2(m,p, 2) ), 0, " |p.e2( 2)| =0", passed)
call expect ( abs(eps2(m,p, 2)*p), 0, " |e2( 2).p|=0", passed)
call expect ( abs(p*eps2(m,p,-2) ), 0, " |p.e2(-2)| =0", passed)
call expect ( abs(eps2(m,p,-2)*p), 0, " |e2(-2).p|=0", passed)
if (m > 0) then
call expect ( abs(p*eps2(m,p, 1) ), 0, " |p.e2( 1)| =0", passed)
call expect ( abs(eps2(m,p, 1)*p), 0, " |e2( 1).p|=0", passed)
call expect ( abs(p*eps2(m,p, 0) ), 0, " |p.e2( 0)| =0", passed)
call expect ( abs(eps2(m,p, 0)*p), 0, " |e2( 0).p|=0", passed)
call expect ( abs(p*eps2(m,p,-1) ), 0, " |p.e2(-1)| =0", passed)
call expect ( abs(eps2(m,p,-1)*p), 0, " |e2(-1).p|=0", passed)
end if
@
<<XXX Test [[omega95]]>>=
print *, " *** Checking the polarization tensors for massive gravitons:"
call expect (abs(p * eps2(m,p,2)), 0, "p.e(+2)=0", passed)
call expect (abs(p * eps2(m,p,1)), 0, "p.e(+1)=0", passed)
call expect (abs(p * eps2(m,p,0)), 0, "p.e( 0)=0", passed)
call expect (abs(p * eps2(m,p,-1)), 0, "p.e(-1)=0", passed)
call expect (abs(p * eps2(m,p,-2)), 0, "p.e(-2)=0", passed)
call expect (abs(trace(eps2 (m,p,2))), 0, "Tr[e(+2)]=0", passed)
call expect (abs(trace(eps2 (m,p,1))), 0, "Tr[e(+1)]=0", passed)
call expect (abs(trace(eps2 (m,p,0))), 0, "Tr[e( 0)]=0", passed)
call expect (abs(trace(eps2 (m,p,-1))), 0, "Tr[e(-1)]=0", passed)
call expect (abs(trace(eps2 (m,p,-2))), 0, "Tr[e(-2)]=0", passed)
call expect (abs(eps2(m,p,2) * eps2(m,p,2)), 1, &
"e(2).e(2) = 1", passed)
call expect (abs(eps2(m,p,2) * eps2(m,p,1)), 0, &
"e(2).e(1) = 0", passed)
call expect (abs(eps2(m,p,2) * eps2(m,p,0)), 0, &
"e(2).e(0) = 0", passed)
call expect (abs(eps2(m,p,2) * eps2(m,p,-1)), 0, &
"e(2).e(-1) = 0", passed)
call expect (abs(eps2(m,p,2) * eps2(m,p,-2)), 0, &
"e(2).e(-2) = 0", passed)
call expect (abs(eps2(m,p,1) * eps2(m,p,1)), 1, &
"e(1).e(1) = 1", passed)
call expect (abs(eps2(m,p,1) * eps2(m,p,0)), 0, &
"e(1).e(0) = 0", passed)
call expect (abs(eps2(m,p,1) * eps2(m,p,-1)), 0, &
"e(1).e(-1) = 0", passed)
call expect (abs(eps2(m,p,1) * eps2(m,p,-2)), 0, &
"e(1).e(-2) = 0", passed)
call expect (abs(eps2(m,p,0) * eps2(m,p,0)), 1, &
"e(0).e(0) = 1", passed)
call expect (abs(eps2(m,p,0) * eps2(m,p,-1)), 0, &
"e(0).e(-1) = 0", passed)
call expect (abs(eps2(m,p,0) * eps2(m,p,-2)), 0, &
"e(0).e(-2) = 0", passed)
call expect (abs(eps2(m,p,-1) * eps2(m,p,-1)), 1, &
"e(-1).e(-1) = 1", passed)
call expect (abs(eps2(m,p,-1) * eps2(m,p,-2)), 0, &
"e(-1).e(-2) = 0", passed)
call expect (abs(eps2(m,p,-2) * eps2(m,p,-2)), 1, &
"e(-2).e(-2) = 1", passed)
@
<<Test [[omega95]]>>=
print *, " *** Checking the graviton propagator:"
call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * &
pr_tensor(p,m,w,eps2(m,p,-2)))), 0, "p.pr.e(-2)", passed)
call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * &
pr_tensor(p,m,w,eps2(m,p,-1)))), 0, "p.pr.e(-1)", passed)
call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * &
pr_tensor(p,m,w,eps2(m,p,0)))), 0, "p.pr.e(0)", passed)
call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * &
pr_tensor(p,m,w,eps2(m,p,1)))), 0, "p.pr.e(1)", passed)
call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * &
pr_tensor(p,m,w,eps2(m,p,2)))), 0, "p.pr.e(2)", passed)
call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * &
pr_tensor(p,m,w,ttest))), 0, "p.pr.ttest", passed)
@
<<[[test_omega95_bispinors.f90]]>>=
<<Copyleft>>
program test_omega95_bispinors
use kinds
use omega95_bispinors
use omega_vspinor_polarizations
use omega_testtools
implicit none
integer :: i, j
real(kind=default) :: m, pabs, qabs, tabs, zabs, w
real(kind=default), dimension(4) :: r
complex(kind=default) :: c_one, c_two
type(momentum) :: p, q, t, z, p_0
type(vector) :: vp, vq, vt, vz
type(vectorspinor) :: testv
logical :: passed
call random_seed ()
c_one = 1
c_two = 2
w = 1.4142
m = 13
pabs = 42
qabs = 137
tabs = 84
zabs = 3.1415
p_0%t = m
p_0%x = 0
call random_momentum (p, pabs, m)
call random_momentum (q, qabs, m)
call random_momentum (t, tabs, m)
call random_momentum (z, zabs, m)
call random_number (r)
do i = 1, 4
testv%psi(1)%a(i) = (0.0_default, 0.0_default)
end do
do i = 2, 3
do j = 1, 4
testv%psi(i)%a(j) = cmplx (10.0_default * r(j))
end do
end do
testv%psi(4)%a(1) = (1.0_default, 0.0_default)
testv%psi(4)%a(2) = (0.0_default, 2.0_default)
testv%psi(4)%a(3) = (1.0_default, 0.0_default)
testv%psi(4)%a(4) = (3.0_default, 0.0_default)
vp = p
vq = q
vt = t
vz = z
passed = .true.
<<Test [[omega95_bispinors]]>>
if (.not. passed) then
stop 1
end if
end program test_omega95_bispinors
@
<<Test [[omega95_bispinors]]>>=
print *, "*** Checking the equations of motion ***:"
call expect (abs(f_vf(c_one,vp,u(m,p,+1))-m*u(m,p,+1)), 0, "|[p-m]u(+)|=0", passed)
call expect (abs(f_vf(c_one,vp,u(m,p,-1))-m*u(m,p,-1)), 0, "|[p-m]u(-)|=0", passed)
call expect (abs(f_vf(c_one,vp,v(m,p,+1))+m*v(m,p,+1)), 0, "|[p+m]v(+)|=0", passed)
call expect (abs(f_vf(c_one,vp,v(m,p,-1))+m*v(m,p,-1)), 0, "|[p+m]v(-)|=0", passed)
print *, "*** Checking the equations of motion for negative masses***:"
call expect (abs(f_vf(c_one,vp,u(-m,p,+1))+m*u(-m,p,+1)), 0, "|[p+m]u(+)|=0", passed)
call expect (abs(f_vf(c_one,vp,u(-m,p,-1))+m*u(-m,p,-1)), 0, "|[p+m]u(-)|=0", passed)
call expect (abs(f_vf(c_one,vp,v(-m,p,+1))-m*v(-m,p,+1)), 0, "|[p-m]v(+)|=0", passed)
call expect (abs(f_vf(c_one,vp,v(-m,p,-1))-m*v(-m,p,-1)), 0, "|[p-m]v(-)|=0", passed)
@
<<Test [[omega95_bispinors]]>>=
print *, "*** Checking the normalization ***:"
call expect (s_ff(c_one,v(m,p,+1),u(m,p,+1)), +2*m, "ubar(+)*u(+)=+2m", passed)
call expect (s_ff(c_one,v(m,p,-1),u(m,p,-1)), +2*m, "ubar(-)*u(-)=+2m", passed)
call expect (s_ff(c_one,u(m,p,+1),v(m,p,+1)), -2*m, "vbar(+)*v(+)=-2m", passed)
call expect (s_ff(c_one,u(m,p,-1),v(m,p,-1)), -2*m, "vbar(-)*v(-)=-2m", passed)
call expect (s_ff(c_one,v(m,p,+1),v(m,p,+1)), 0, "ubar(+)*v(+)=0 ", passed)
call expect (s_ff(c_one,v(m,p,-1),v(m,p,-1)), 0, "ubar(-)*v(-)=0 ", passed)
call expect (s_ff(c_one,u(m,p,+1),u(m,p,+1)), 0, "vbar(+)*u(+)=0 ", passed)
call expect (s_ff(c_one,u(m,p,-1),u(m,p,-1)), 0, "vbar(-)*u(-)=0 ", passed)
print *, "*** Checking the normalization for negative masses***:"
call expect (s_ff(c_one,v(-m,p,+1),u(-m,p,+1)), -2*m, "ubar(+)*u(+)=-2m", passed)
call expect (s_ff(c_one,v(-m,p,-1),u(-m,p,-1)), -2*m, "ubar(-)*u(-)=-2m", passed)
call expect (s_ff(c_one,u(-m,p,+1),v(-m,p,+1)), +2*m, "vbar(+)*v(+)=+2m", passed)
call expect (s_ff(c_one,u(-m,p,-1),v(-m,p,-1)), +2*m, "vbar(-)*v(-)=+2m", passed)
call expect (s_ff(c_one,v(-m,p,+1),v(-m,p,+1)), 0, "ubar(+)*v(+)=0 ", passed)
call expect (s_ff(c_one,v(-m,p,-1),v(-m,p,-1)), 0, "ubar(-)*v(-)=0 ", passed)
call expect (s_ff(c_one,u(-m,p,+1),u(-m,p,+1)), 0, "vbar(+)*u(+)=0 ", passed)
call expect (s_ff(c_one,u(-m,p,-1),u(-m,p,-1)), 0, "vbar(-)*u(-)=0 ", passed)
@
<<Test [[omega95_bispinors]]>>=
print *, "*** Checking the currents ***:"
call expect (abs(v_ff(c_one,v(m,p,+1),u(m,p,+1))-2*vp), 0, "ubar(+).V.u(+)=2p", passed)
call expect (abs(v_ff(c_one,v(m,p,-1),u(m,p,-1))-2*vp), 0, "ubar(-).V.u(-)=2p", passed)
call expect (abs(v_ff(c_one,u(m,p,+1),v(m,p,+1))-2*vp), 0, "vbar(+).V.v(+)=2p", passed)
call expect (abs(v_ff(c_one,u(m,p,-1),v(m,p,-1))-2*vp), 0, "vbar(-).V.v(-)=2p", passed)
print *, "*** Checking the currents for negative masses***:"
call expect (abs(v_ff(c_one,v(-m,p,+1),u(-m,p,+1))-2*vp), 0, "ubar(+).V.u(+)=2p", passed)
call expect (abs(v_ff(c_one,v(-m,p,-1),u(-m,p,-1))-2*vp), 0, "ubar(-).V.u(-)=2p", passed)
call expect (abs(v_ff(c_one,u(-m,p,+1),v(-m,p,+1))-2*vp), 0, "vbar(+).V.v(+)=2p", passed)
call expect (abs(v_ff(c_one,u(-m,p,-1),v(-m,p,-1))-2*vp), 0, "vbar(-).V.v(-)=2p", passed)
@
<<Test [[omega95_bispinors]]>>=
print *, "*** Checking current conservation ***:"
call expect ((vp-vq)*v_ff(c_one,v(m,p,+1),u(m,q,+1)), 0, "d(ubar(+).V.u(+))=0", passed)
call expect ((vp-vq)*v_ff(c_one,v(m,p,-1),u(m,q,-1)), 0, "d(ubar(-).V.u(-))=0", passed)
call expect ((vp-vq)*v_ff(c_one,u(m,p,+1),v(m,q,+1)), 0, "d(vbar(+).V.v(+))=0", passed)
call expect ((vp-vq)*v_ff(c_one,u(m,p,-1),v(m,q,-1)), 0, "d(vbar(-).V.v(-))=0", passed)
<<Test [[omega95_bispinors]]>>=
print *, "*** Checking current conservation for negative masses***:"
call expect ((vp-vq)*v_ff(c_one,v(-m,p,+1),u(-m,q,+1)), 0, "d(ubar(+).V.u(+))=0", passed)
call expect ((vp-vq)*v_ff(c_one,v(-m,p,-1),u(-m,q,-1)), 0, "d(ubar(-).V.u(-))=0", passed)
call expect ((vp-vq)*v_ff(c_one,u(-m,p,+1),v(-m,q,+1)), 0, "d(vbar(+).V.v(+))=0", passed)
call expect ((vp-vq)*v_ff(c_one,u(-m,p,-1),v(-m,q,-1)), 0, "d(vbar(-).V.v(-))=0", passed)
@
<<Test [[omega95_bispinors]]>>=
if (m == 0) then
print *, "*** Checking axial current conservation ***:"
call expect ((vp-vq)*a_ff(c_one,v(m,p,+1),u(m,q,+1)), 0, "d(ubar(+).A.u(+))=0", passed)
call expect ((vp-vq)*a_ff(c_one,v(m,p,-1),u(m,q,-1)), 0, "d(ubar(-).A.u(-))=0", passed)
call expect ((vp-vq)*a_ff(c_one,u(m,p,+1),v(m,q,+1)), 0, "d(vbar(+).A.v(+))=0", passed)
call expect ((vp-vq)*a_ff(c_one,u(m,p,-1),v(m,q,-1)), 0, "d(vbar(-).A.v(-))=0", passed)
end if
@
<<Test [[omega95_bispinors]]>>=
print *, "*** Checking polarization vectors: ***"
call expect (conjg(eps(m,p, 1))*eps(m,p, 1), -1, "e( 1).e( 1)=-1", passed)
call expect (conjg(eps(m,p, 1))*eps(m,p,-1), 0, "e( 1).e(-1)= 0", passed)
call expect (conjg(eps(m,p,-1))*eps(m,p, 1), 0, "e(-1).e( 1)= 0", passed)
call expect (conjg(eps(m,p,-1))*eps(m,p,-1), -1, "e(-1).e(-1)=-1", passed)
call expect ( p*eps(m,p, 1), 0, " p.e( 1)= 0", passed)
call expect ( p*eps(m,p,-1), 0, " p.e(-1)= 0", passed)
if (m > 0) then
call expect (conjg(eps(m,p, 1))*eps(m,p, 0), 0, "e( 1).e( 0)= 0", passed)
call expect (conjg(eps(m,p, 0))*eps(m,p, 1), 0, "e( 0).e( 1)= 0", passed)
call expect (conjg(eps(m,p, 0))*eps(m,p, 0), -1, "e( 0).e( 0)=-1", passed)
call expect (conjg(eps(m,p, 0))*eps(m,p,-1), 0, "e( 0).e(-1)= 0", passed)
call expect (conjg(eps(m,p,-1))*eps(m,p, 0), 0, "e(-1).e( 0)= 0", passed)
call expect ( p*eps(m,p, 0), 0, " p.e( 0)= 0", passed)
end if
@
<<Test [[omega95_bispinors]]>>=
print *, "*** Checking polarization vectorspinors: ***"
call expect (abs(p * ueps(m, p, 2)), 0, "p.ueps ( 2)= 0", passed)
call expect (abs(p * ueps(m, p, 1)), 0, "p.ueps ( 1)= 0", passed)
call expect (abs(p * ueps(m, p, -1)), 0, "p.ueps (-1)= 0", passed)
call expect (abs(p * ueps(m, p, -2)), 0, "p.ueps (-2)= 0", passed)
call expect (abs(p * veps(m, p, 2)), 0, "p.veps ( 2)= 0", passed)
call expect (abs(p * veps(m, p, 1)), 0, "p.veps ( 1)= 0", passed)
call expect (abs(p * veps(m, p, -1)), 0, "p.veps (-1)= 0", passed)
call expect (abs(p * veps(m, p, -2)), 0, "p.veps (-2)= 0", passed)
print *, "*** Checking polarization vectorspinors (neg. masses): ***"
call expect (abs(p * ueps(-m, p, 2)), 0, "p.ueps ( 2)= 0", passed)
call expect (abs(p * ueps(-m, p, 1)), 0, "p.ueps ( 1)= 0", passed)
call expect (abs(p * ueps(-m, p, -1)), 0, "p.ueps (-1)= 0", passed)
call expect (abs(p * ueps(-m, p, -2)), 0, "p.ueps (-2)= 0", passed)
call expect (abs(p * veps(-m, p, 2)), 0, "p.veps ( 2)= 0", passed)
call expect (abs(p * veps(-m, p, 1)), 0, "p.veps ( 1)= 0", passed)
call expect (abs(p * veps(-m, p, -1)), 0, "p.veps (-1)= 0", passed)
call expect (abs(p * veps(-m, p, -2)), 0, "p.veps (-2)= 0", passed)
print *, "*** in the rest frame ***"
call expect (abs(p_0 * ueps(m, p_0, 2)), 0, "p0.ueps ( 2)= 0", passed)
call expect (abs(p_0 * ueps(m, p_0, 1)), 0, "p0.ueps ( 1)= 0", passed)
call expect (abs(p_0 * ueps(m, p_0, -1)), 0, "p0.ueps (-1)= 0", passed)
call expect (abs(p_0 * ueps(m, p_0, -2)), 0, "p0.ueps (-2)= 0", passed)
call expect (abs(p_0 * veps(m, p_0, 2)), 0, "p0.veps ( 2)= 0", passed)
call expect (abs(p_0 * veps(m, p_0, 1)), 0, "p0.veps ( 1)= 0", passed)
call expect (abs(p_0 * veps(m, p_0, -1)), 0, "p0.veps (-1)= 0", passed)
call expect (abs(p_0 * veps(m, p_0, -2)), 0, "p0.veps (-2)= 0", passed)
print *, "*** in the rest frame (neg. masses) ***"
call expect (abs(p_0 * ueps(-m, p_0, 2)), 0, "p0.ueps ( 2)= 0", passed)
call expect (abs(p_0 * ueps(-m, p_0, 1)), 0, "p0.ueps ( 1)= 0", passed)
call expect (abs(p_0 * ueps(-m, p_0, -1)), 0, "p0.ueps (-1)= 0", passed)
call expect (abs(p_0 * ueps(-m, p_0, -2)), 0, "p0.ueps (-2)= 0", passed)
call expect (abs(p_0 * veps(-m, p_0, 2)), 0, "p0.veps ( 2)= 0", passed)
call expect (abs(p_0 * veps(-m, p_0, 1)), 0, "p0.veps ( 1)= 0", passed)
call expect (abs(p_0 * veps(-m, p_0, -1)), 0, "p0.veps (-1)= 0", passed)
call expect (abs(p_0 * veps(-m, p_0, -2)), 0, "p0.veps (-2)= 0", passed)
@
<<Test [[omega95_bispinors]]>>=
print *, "*** Checking the irreducibility condition: ***"
call expect (abs(f_potgr (c_one, c_one, ueps(m, p, 2))), 0, "g.ueps ( 2)", passed)
call expect (abs(f_potgr (c_one, c_one, ueps(m, p, 1))), 0, "g.ueps ( 1)", passed)
call expect (abs(f_potgr (c_one, c_one, ueps(m, p, -1))), 0, "g.ueps (-1)", passed)
call expect (abs(f_potgr (c_one, c_one, ueps(m, p, -2))), 0, "g.ueps (-2)", passed)
call expect (abs(f_potgr (c_one, c_one, veps(m, p, 2))), 0, "g.veps ( 2)", passed)
call expect (abs(f_potgr (c_one, c_one, veps(m, p, 1))), 0, "g.veps ( 1)", passed)
call expect (abs(f_potgr (c_one, c_one, veps(m, p, -1))), 0, "g.veps (-1)", passed)
call expect (abs(f_potgr (c_one, c_one, veps(m, p, -2))), 0, "g.veps (-2)", passed)
print *, "*** Checking the irreducibility condition (neg. masses): ***"
call expect (abs(f_potgr (c_one, c_one, ueps(-m, p, 2))), 0, "g.ueps ( 2)", passed)
call expect (abs(f_potgr (c_one, c_one, ueps(-m, p, 1))), 0, "g.ueps ( 1)", passed)
call expect (abs(f_potgr (c_one, c_one, ueps(-m, p, -1))), 0, "g.ueps (-1)", passed)
call expect (abs(f_potgr (c_one, c_one, ueps(-m, p, -2))), 0, "g.ueps (-2)", passed)
call expect (abs(f_potgr (c_one, c_one, veps(-m, p, 2))), 0, "g.veps ( 2)", passed)
call expect (abs(f_potgr (c_one, c_one, veps(-m, p, 1))), 0, "g.veps ( 1)", passed)
call expect (abs(f_potgr (c_one, c_one, veps(-m, p, -1))), 0, "g.veps (-1)", passed)
call expect (abs(f_potgr (c_one, c_one, veps(-m, p, -2))), 0, "g.veps (-2)", passed)
print *, "*** in the rest frame ***"
call expect (abs(f_potgr (c_one, c_one, ueps(m, p_0, 2))), 0, "g.ueps ( 2)", passed)
call expect (abs(f_potgr (c_one, c_one, ueps(m, p_0, 1))), 0, "g.ueps ( 1)", passed)
call expect (abs(f_potgr (c_one, c_one, ueps(m, p_0, -1))), 0, "g.ueps (-1)", passed)
call expect (abs(f_potgr (c_one, c_one, ueps(m, p_0, -2))), 0, "g.ueps (-2)", passed)
call expect (abs(f_potgr (c_one, c_one, veps(m, p_0, 2))), 0, "g.veps ( 2)", passed)
call expect (abs(f_potgr (c_one, c_one, veps(m, p_0, 1))), 0, "g.veps ( 1)", passed)
call expect (abs(f_potgr (c_one, c_one, veps(m, p_0, -1))), 0, "g.veps (-1)", passed)
call expect (abs(f_potgr (c_one, c_one, veps(m, p_0, -2))), 0, "g.veps (-2)", passed)
print *, "*** in the rest frame (neg. masses) ***"
call expect (abs(f_potgr (c_one, c_one, ueps(m, p_0, 2))), 0, "g.ueps ( 2)", passed)
call expect (abs(f_potgr (c_one, c_one, ueps(m, p_0, 1))), 0, "g.ueps ( 1)", passed)
call expect (abs(f_potgr (c_one, c_one, ueps(m, p_0, -1))), 0, "g.ueps (-1)", passed)
call expect (abs(f_potgr (c_one, c_one, ueps(m, p_0, -2))), 0, "g.ueps (-2)", passed)
call expect (abs(f_potgr (c_one, c_one, veps(m, p_0, 2))), 0, "g.veps ( 2)", passed)
call expect (abs(f_potgr (c_one, c_one, veps(m, p_0, 1))), 0, "g.veps ( 1)", passed)
call expect (abs(f_potgr (c_one, c_one, veps(m, p_0, -1))), 0, "g.veps (-1)", passed)
call expect (abs(f_potgr (c_one, c_one, veps(m, p_0, -2))), 0, "g.veps (-2)", passed)
@
<<Test [[omega95_bispinors]]>>=
print *, "*** Testing vectorspinor normalization ***"
call expect (veps(m,p, 2)*ueps(m,p, 2), -2*m, "ueps( 2).ueps( 2)= -2m", passed)
call expect (veps(m,p, 1)*ueps(m,p, 1), -2*m, "ueps( 1).ueps( 1)= -2m", passed)
call expect (veps(m,p,-1)*ueps(m,p,-1), -2*m, "ueps(-1).ueps(-1)= -2m", passed)
call expect (veps(m,p,-2)*ueps(m,p,-2), -2*m, "ueps(-2).ueps(-2)= -2m", passed)
call expect (ueps(m,p, 2)*veps(m,p, 2), 2*m, "veps( 2).veps( 2)= +2m", passed)
call expect (ueps(m,p, 1)*veps(m,p, 1), 2*m, "veps( 1).veps( 1)= +2m", passed)
call expect (ueps(m,p,-1)*veps(m,p,-1), 2*m, "veps(-1).veps(-1)= +2m", passed)
call expect (ueps(m,p,-2)*veps(m,p,-2), 2*m, "veps(-2).veps(-2)= +2m", passed)
call expect (ueps(m,p, 2)*ueps(m,p, 2), 0, "ueps( 2).veps( 2)= 0", passed)
call expect (ueps(m,p, 1)*ueps(m,p, 1), 0, "ueps( 1).veps( 1)= 0", passed)
call expect (ueps(m,p,-1)*ueps(m,p,-1), 0, "ueps(-1).veps(-1)= 0", passed)
call expect (ueps(m,p,-2)*ueps(m,p,-2), 0, "ueps(-2).veps(-2)= 0", passed)
call expect (veps(m,p, 2)*veps(m,p, 2), 0, "veps( 2).ueps( 2)= 0", passed)
call expect (veps(m,p, 1)*veps(m,p, 1), 0, "veps( 1).ueps( 1)= 0", passed)
call expect (veps(m,p,-1)*veps(m,p,-1), 0, "veps(-1).ueps(-1)= 0", passed)
call expect (veps(m,p,-2)*veps(m,p,-2), 0, "veps(-2).ueps(-2)= 0", passed)
print *, "*** Testing vectorspinor normalization (neg. masses) ***"
call expect (veps(-m,p, 2)*ueps(-m,p, 2), +2*m, "ueps( 2).ueps( 2)= +2m", passed)
call expect (veps(-m,p, 1)*ueps(-m,p, 1), +2*m, "ueps( 1).ueps( 1)= +2m", passed)
call expect (veps(-m,p,-1)*ueps(-m,p,-1), +2*m, "ueps(-1).ueps(-1)= +2m", passed)
call expect (veps(-m,p,-2)*ueps(-m,p,-2), +2*m, "ueps(-2).ueps(-2)= +2m", passed)
call expect (ueps(-m,p, 2)*veps(-m,p, 2), -2*m, "veps( 2).veps( 2)= -2m", passed)
call expect (ueps(-m,p, 1)*veps(-m,p, 1), -2*m, "veps( 1).veps( 1)= -2m", passed)
call expect (ueps(-m,p,-1)*veps(-m,p,-1), -2*m, "veps(-1).veps(-1)= -2m", passed)
call expect (ueps(-m,p,-2)*veps(-m,p,-2), -2*m, "veps(-2).veps(-2)= -2m", passed)
call expect (ueps(-m,p, 2)*ueps(-m,p, 2), 0, "ueps( 2).veps( 2)= 0", passed)
call expect (ueps(-m,p, 1)*ueps(-m,p, 1), 0, "ueps( 1).veps( 1)= 0", passed)
call expect (ueps(-m,p,-1)*ueps(-m,p,-1), 0, "ueps(-1).veps(-1)= 0", passed)
call expect (ueps(-m,p,-2)*ueps(-m,p,-2), 0, "ueps(-2).veps(-2)= 0", passed)
call expect (veps(-m,p, 2)*veps(-m,p, 2), 0, "veps( 2).ueps( 2)= 0", passed)
call expect (veps(-m,p, 1)*veps(-m,p, 1), 0, "veps( 1).ueps( 1)= 0", passed)
call expect (veps(-m,p,-1)*veps(-m,p,-1), 0, "veps(-1).ueps(-1)= 0", passed)
call expect (veps(-m,p,-2)*veps(-m,p,-2), 0, "veps(-2).ueps(-2)= 0", passed)
print *, "*** in the rest frame ***"
call expect (veps(m,p_0, 2)*ueps(m,p_0, 2), -2*m, "ueps( 2).ueps( 2)= -2m", passed)
call expect (veps(m,p_0, 1)*ueps(m,p_0, 1), -2*m, "ueps( 1).ueps( 1)= -2m", passed)
call expect (veps(m,p_0,-1)*ueps(m,p_0,-1), -2*m, "ueps(-1).ueps(-1)= -2m", passed)
call expect (veps(m,p_0,-2)*ueps(m,p_0,-2), -2*m, "ueps(-2).ueps(-2)= -2m", passed)
call expect (ueps(m,p_0, 2)*veps(m,p_0, 2), 2*m, "veps( 2).veps( 2)= +2m", passed)
call expect (ueps(m,p_0, 1)*veps(m,p_0, 1), 2*m, "veps( 1).veps( 1)= +2m", passed)
call expect (ueps(m,p_0,-1)*veps(m,p_0,-1), 2*m, "veps(-1).veps(-1)= +2m", passed)
call expect (ueps(m,p_0,-2)*veps(m,p_0,-2), 2*m, "veps(-2).veps(-2)= +2m", passed)
call expect (ueps(m,p_0, 2)*ueps(m,p_0, 2), 0, "ueps( 2).veps( 2)= 0", passed)
call expect (ueps(m,p_0, 1)*ueps(m,p_0, 1), 0, "ueps( 1).veps( 1)= 0", passed)
call expect (ueps(m,p_0,-1)*ueps(m,p_0,-1), 0, "ueps(-1).veps(-1)= 0", passed)
call expect (ueps(m,p_0,-2)*ueps(m,p_0,-2), 0, "ueps(-2).veps(-2)= 0", passed)
call expect (veps(m,p_0, 2)*veps(m,p_0, 2), 0, "veps( 2).ueps( 2)= 0", passed)
call expect (veps(m,p_0, 1)*veps(m,p_0, 1), 0, "veps( 1).ueps( 1)= 0", passed)
call expect (veps(m,p_0,-1)*veps(m,p_0,-1), 0, "veps(-1).ueps(-1)= 0", passed)
call expect (veps(m,p_0,-2)*veps(m,p_0,-2), 0, "veps(-2).ueps(-2)= 0", passed)
print *, "*** in the rest frame (neg. masses) ***"
call expect (veps(-m,p_0, 2)*ueps(-m,p_0, 2), +2*m, "ueps( 2).ueps( 2)= +2m", passed)
call expect (veps(-m,p_0, 1)*ueps(-m,p_0, 1), +2*m, "ueps( 1).ueps( 1)= +2m", passed)
call expect (veps(-m,p_0,-1)*ueps(-m,p_0,-1), +2*m, "ueps(-1).ueps(-1)= +2m", passed)
call expect (veps(-m,p_0,-2)*ueps(-m,p_0,-2), +2*m, "ueps(-2).ueps(-2)= +2m", passed)
call expect (ueps(-m,p_0, 2)*veps(-m,p_0, 2), -2*m, "veps( 2).veps( 2)= -2m", passed)
call expect (ueps(-m,p_0, 1)*veps(-m,p_0, 1), -2*m, "veps( 1).veps( 1)= -2m", passed)
call expect (ueps(-m,p_0,-1)*veps(-m,p_0,-1), -2*m, "veps(-1).veps(-1)= -2m", passed)
call expect (ueps(-m,p_0,-2)*veps(-m,p_0,-2), -2*m, "veps(-2).veps(-2)= -2m", passed)
call expect (ueps(-m,p_0, 2)*ueps(-m,p_0, 2), 0, "ueps( 2).veps( 2)= 0", passed)
call expect (ueps(-m,p_0, 1)*ueps(-m,p_0, 1), 0, "ueps( 1).veps( 1)= 0", passed)
call expect (ueps(-m,p_0,-1)*ueps(-m,p_0,-1), 0, "ueps(-1).veps(-1)= 0", passed)
call expect (ueps(-m,p_0,-2)*ueps(-m,p_0,-2), 0, "ueps(-2).veps(-2)= 0", passed)
call expect (veps(-m,p_0, 2)*veps(-m,p_0, 2), 0, "veps( 2).ueps( 2)= 0", passed)
call expect (veps(-m,p_0, 1)*veps(-m,p_0, 1), 0, "veps( 1).ueps( 1)= 0", passed)
call expect (veps(-m,p_0,-1)*veps(-m,p_0,-1), 0, "veps(-1).ueps(-1)= 0", passed)
call expect (veps(-m,p_0,-2)*veps(-m,p_0,-2), 0, "veps(-2).ueps(-2)= 0", passed)
@
<<Test [[omega95_bispinors]]>>=
print *, "*** Majorana properties of gravitino vertices: ***"
call expect (abs(u (m,q,1) * f_sgr (c_one, c_one, ueps(m,p,2), t) + &
ueps(m,p,2) * gr_sf(c_one,c_one,u(m,q,1),t)), 0, "f_sgr + gr_sf = 0", passed)
!!! call expect (abs(u (m,q,-1) * f_sgr (c_one, c_one, ueps(m,p,2), t) + &
!!! ueps(m,p,2) * gr_sf(c_one,c_one,u(m,q,-1),t)), 0, "f_sgr + gr_sf = 0", passed)
!!! call expect (abs(u (m,q,1) * f_sgr (c_one, c_one, ueps(m,p,1), t) + &
!!! ueps(m,p,1) * gr_sf(c_one,c_one,u(m,q,1),t)), 0, "f_sgr + gr_sf = 0", passed)
!!! call expect (abs(u (m,q,-1) * f_sgr (c_one, c_one, ueps(m,p,1), t) + &
!!! ueps(m,p,1) * gr_sf(c_one,c_one,u(m,q,-1),t)), 0, "f_sgr + gr_sf = 0", passed)
!!! call expect (abs(u (m,q,1) * f_sgr (c_one, c_one, ueps(m,p,-1), t) + &
!!! ueps(m,p,-1) * gr_sf(c_one,c_one,u(m,q,1),t)), 0, "f_sgr + gr_sf = 0", passed)
!!! call expect (abs(u (m,q,-1) * f_sgr (c_one, c_one, ueps(m,p,-1), t) + &
!!! ueps(m,p,-1) * gr_sf(c_one,c_one,u(m,q,-1),t)), 0, "f_sgr + gr_sf = 0", passed)
!!! call expect (abs(u (m,q,1) * f_sgr (c_one, c_one, ueps(m,p,-2), t) + &
!!! ueps(m,p,-2) * gr_sf(c_one,c_one,u(m,q,1),t)), 0, "f_sgr + gr_sf = 0", passed)
!!! call expect (abs(u (m,q,-1) * f_sgr (c_one, c_one, ueps(m,p,-2), t) + &
!!! ueps(m,p,-2) * gr_sf(c_one,c_one,u(m,q,-1),t)), 0, "f_sgr + gr_sf = 0", passed)
call expect (abs(u (m,q,1) * f_slgr (c_one, c_one, ueps(m,p,2), t) + &
ueps(m,p,2) * gr_slf(c_one,c_one,u(m,q,1),t)), 0, "f_slgr + gr_slf = 0", passed)
call expect (abs(u (m,q,1) * f_srgr (c_one, c_one, ueps(m,p,2), t) + &
ueps(m,p,2) * gr_srf(c_one,c_one,u(m,q,1),t)), 0, "f_srgr + gr_srf = 0", passed)
call expect (abs(u (m,q,1) * f_slrgr (c_one, c_two, c_one, ueps(m,p,2), t) + &
ueps(m,p,2) * gr_slrf(c_one,c_two,c_one,u(m,q,1),t)), 0, "f_slrgr + gr_slrf = 0", passed)
call expect (abs(u (m,q,1) * f_pgr (c_one, c_one, ueps(m,p,2), t) + &
ueps(m,p,2) * gr_pf(c_one,c_one,u(m,q,1),t)), 0, "f_pgr + gr_pf = 0", passed)
call expect (abs(u (m,q,1) * f_vgr (c_one, vt, ueps(m,p,2), p+q) + &
ueps(m,p,2) * gr_vf(c_one,vt,u(m,q,1),p+q)), 0, "f_vgr + gr_vf = 0", passed)
call expect (abs(u (m,q,1) * f_vlrgr (c_one, c_two, vt, ueps(m,p,2), p+q) + &
ueps(m,p,2) * gr_vlrf(c_one,c_two,vt,u(m,q,1),p+q)), 0, "f_vlrgr + gr_vlrf = 0", passed)
!!! call expect (abs(u (m,q,-1) * f_vgr (c_one, vt, ueps(m,p,2), p+q) + &
!!! ueps(m,p,2) * gr_vf(c_one,vt,u(m,q,-1),p+q)), 0, "f_vgr + gr_vf = 0", passed)
!!! call expect (abs(u (m,q,1) * f_vgr (c_one, vt, ueps(m,p,1), p+q) + &
!!! ueps(m,p,1) * gr_vf(c_one,vt,u(m,q,1),p+q)), 0, "f_vgr + gr_vf = 0", passed)
!!! call expect (abs(u (m,q,-1) * f_vgr (c_one, vt, ueps(m,p,1), p+q) + &
!!! ueps(m,p,1) * gr_vf(c_one,vt,u(m,q,-1),p+q)), 0, "f_vgr + gr_vf = 0", passed)
!!! call expect (abs(u (m,q,1) * f_vgr (c_one, vt, ueps(m,p,-1), p+q) + &
!!! ueps(m,p,-1) * gr_vf(c_one,vt,u(m,q,1),p+q)), 0, "f_vgr + gr_vf = 0", passed)
!!! call expect (abs(u (m,q,-1) * f_vgr (c_one, vt, veps(m,p,-1), p+q) + &
!!! veps(m,p,-1) * gr_vf(c_one,vt,u(m,q,-1),p+q)), 0, "f_vgr + gr_vf = 0", passed)
!!! call expect (abs(v (m,q,1) * f_vgr (c_one, vt, ueps(m,p,-2), p+q) + &
!!! ueps(m,p,-2) * gr_vf(c_one,vt,v(m,q,1),p+q)), 0, "f_vgr + gr_vf = 0", passed)
!!! call expect (abs(u (m,q,-1) * f_vgr (c_one, vt, ueps(m,p,-2), p+q) + &
!!! ueps(m,p,-2) * gr_vf(c_one,vt,u(m,q,-1),p+q)), 0, "f_vgr + gr_vf = 0", passed)
call expect (abs(s_grf (c_one, ueps(m,p,2), u(m,q,1),t) + &
s_fgr(c_one,u(m,q,1),ueps(m,p,2),t)), 0, "s_grf + s_fgr = 0", passed)
call expect (abs(sl_grf (c_one, ueps(m,p,2), u(m,q,1),t) + &
sl_fgr(c_one,u(m,q,1),ueps(m,p,2),t)), 0, "sl_grf + sl_fgr = 0", passed)
call expect (abs(sr_grf (c_one, ueps(m,p,2), u(m,q,1),t) + &
sr_fgr(c_one,u(m,q,1),ueps(m,p,2),t)), 0, "sr_grf + sr_fgr = 0", passed)
call expect (abs(slr_grf (c_one, c_two, ueps(m,p,2), u(m,q,1),t) + &
slr_fgr(c_one,c_two,u(m,q,1),ueps(m,p,2),t)), 0, "slr_grf + slr_fgr = 0", passed)
call expect (abs(p_grf (c_one, ueps(m,p,2), u(m,q,1),t) + &
p_fgr(c_one,u(m,q,1),ueps(m,p,2),t)), 0, "p_grf + p_fgr = 0", passed)
call expect (abs(v_grf (c_one, ueps(m,p,2), u(m,q,1),t) + &
v_fgr(c_one,u(m,q,1),ueps(m,p,2),t)), 0, "v_grf + v_fgr = 0", passed)
call expect (abs(vlr_grf (c_one, c_two, ueps(m,p,2), u(m,q,1),t) + &
vlr_fgr(c_one,c_two,u(m,q,1),ueps(m,p,2),t)), 0, "vlr_grf + vlr_fgr = 0", passed)
call expect (abs(u(m,p,1) * f_potgr (c_one,c_one,testv) - testv * gr_potf &
(c_one,c_one,u (m,p,1))), 0, "f_potgr - gr_potf = 0", passed)
call expect (abs (pot_fgr (c_one,u(m,p,1),testv) - pot_grf(c_one, &
testv,u(m,p,1))), 0, "pot_fgr - pot_grf = 0", passed)
call expect (abs(u(m,p,1) * f_s2gr (c_one,c_one,c_one,testv) - testv * gr_s2f &
(c_one,c_one,c_one,u (m,p,1))), 0, "f_s2gr - gr_s2f = 0", passed)
call expect (abs (s2_fgr (c_one,u(m,p,1),c_one,testv) - s2_grf(c_one, &
testv,c_one,u(m,p,1))), 0, "s2_fgr - s2_grf = 0", passed)
call expect (abs(u (m,q,1) * f_svgr (c_one, c_one, vt, ueps(m,p,2)) + &
ueps(m,p,2) * gr_svf(c_one,c_one,vt,u(m,q,1))), 0, "f_svgr + gr_svf = 0", passed)
call expect (abs(u (m,q,1) * f_slvgr (c_one, c_one, vt, ueps(m,p,2)) + &
ueps(m,p,2) * gr_slvf(c_one,c_one,vt,u(m,q,1))), 0, "f_slvgr + gr_slvf = 0", passed)
call expect (abs(u (m,q,1) * f_srvgr (c_one, c_one, vt, ueps(m,p,2)) + &
ueps(m,p,2) * gr_srvf(c_one,c_one,vt,u(m,q,1))), 0, "f_srvgr + gr_srvf = 0", passed)
call expect (abs(u (m,q,1) * f_slrvgr (c_one, c_two, c_one, vt, ueps(m,p,2)) + &
ueps(m,p,2) * gr_slrvf(c_one,c_two,c_one,vt,u(m,q,1))), 0, "f_slrvgr + gr_slrvf = 0", passed)
call expect (abs (sv1_fgr (c_one,u(m,p,1),vt,ueps(m,q,2)) + sv1_grf(c_one, &
ueps(m,q,2),vt,u(m,p,1))), 0, "sv1_fgr + sv1_grf = 0", passed)
call expect (abs (sv2_fgr (c_one,u(m,p,1),c_one,ueps(m,q,2)) + sv2_grf(c_one, &
ueps(m,q,2),c_one,u(m,p,1))), 0, "sv2_fgr + sv2_grf = 0", passed)
call expect (abs (slv1_fgr (c_one,u(m,p,1),vt,ueps(m,q,2)) + slv1_grf(c_one, &
ueps(m,q,2),vt,u(m,p,1))), 0, "slv1_fgr + slv1_grf = 0", passed)
call expect (abs (srv2_fgr (c_one,u(m,p,1),c_one,ueps(m,q,2)) + srv2_grf(c_one, &
ueps(m,q,2),c_one,u(m,p,1))), 0, "srv2_fgr + srv2_grf = 0", passed)
call expect (abs (slrv1_fgr (c_one,c_two,u(m,p,1),vt,ueps(m,q,2)) + slrv1_grf(c_one,c_two, &
ueps(m,q,2),vt,u(m,p,1))), 0, "slrv1_fgr + slrv1_grf = 0", passed)
call expect (abs (slrv2_fgr (c_one,c_two,u(m,p,1),c_one,ueps(m,q,2)) + slrv2_grf(c_one, &
c_two,ueps(m,q,2),c_one,u(m,p,1))), 0, "slrv2_fgr + slrv2_grf = 0", passed)
call expect (abs(u (m,q,1) * f_pvgr (c_one, c_one, vt, ueps(m,p,2)) + &
ueps(m,p,2) * gr_pvf(c_one,c_one,vt,u(m,q,1))), 0, "f_pvgr + gr_pvf = 0", passed)
call expect (abs (pv1_fgr (c_one,u(m,p,1),vt,ueps(m,q,2)) + pv1_grf(c_one, &
ueps(m,q,2),vt,u(m,p,1))), 0, "pv1_fgr + pv1_grf = 0", passed)
call expect (abs (pv2_fgr (c_one,u(m,p,1),c_one,ueps(m,q,2)) + pv2_grf(c_one, &
ueps(m,q,2),c_one,u(m,p,1))), 0, "pv2_fgr + pv2_grf = 0", passed)
call expect (abs(u (m,q,1) * f_v2gr (c_one, vt, vz, ueps(m,p,2)) + &
ueps(m,p,2) * gr_v2f(c_one,vt,vz,u(m,q,1))), 0, "f_v2gr + gr_v2f = 0", passed)
call expect (abs(u (m,q,1) * f_v2lrgr (c_one, c_two, vt, vz, ueps(m,p,2)) + &
ueps(m,p,2) * gr_v2lrf(c_one,c_two,vt,vz,u(m,q,1))), 0, "f_v2lrgr + gr_v2lrf = 0", passed)
call expect (abs (v2_fgr (c_one,u(m,p,1),vt,ueps(m,q,2)) + v2_grf(c_one, &
ueps(m,q,2),vt,u(m,p,1))), 0, "v2_fgr + v2_grf = 0", passed)
call expect (abs (v2lr_fgr (c_one,c_two,u(m,p,1),vt,ueps(m,q,2)) + v2lr_grf(c_one, c_two, &
ueps(m,q,2),vt,u(m,p,1))), 0, "v2lr_fgr + v2lr_grf = 0", passed)
@
<<Test [[omega95_bispinors]]>>=
print *, "*** Testing the gravitino propagator: ***"
print *, "Transversality:"
call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * &
pr_grav(p,m,w,testv))), 0, "p.pr.test", passed)
call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * &
pr_grav(p,m,w,ueps(m,p,2)))), 0, "p.pr.ueps ( 2)", passed)
call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * &
pr_grav(p,m,w,ueps(m,p,1)))), 0, "p.pr.ueps ( 1)", passed)
call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * &
pr_grav(p,m,w,ueps(m,p,-1)))), 0, "p.pr.ueps (-1)", passed)
call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * &
pr_grav(p,m,w,ueps(m,p,-2)))), 0, "p.pr.ueps (-2)", passed)
call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * &
pr_grav(p,m,w,veps(m,p,2)))), 0, "p.pr.veps ( 2)", passed)
call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * &
pr_grav(p,m,w,veps(m,p,1)))), 0, "p.pr.veps ( 1)", passed)
call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * &
pr_grav(p,m,w,veps(m,p,-1)))), 0, "p.pr.veps (-1)", passed)
call expect (abs(p * (cmplx (p*p - m**2, m*w, kind=default) * &
pr_grav(p,m,w,veps(m,p,-2)))), 0, "p.pr.veps (-2)", passed)
print *, "Irreducibility:"
call expect (abs(f_potgr (c_one, c_one, (cmplx (p*p - m**2, m*w, &
kind=default) * pr_grav(p,m,w,testv)))), 0, "g.pr.test", passed)
call expect (abs(f_potgr (c_one, c_one, (cmplx (p*p - m**2, m*w, &
kind=default) * pr_grav(p,m,w,ueps(m,p,2))))), 0, &
"g.pr.ueps ( 2)", passed)
call expect (abs(f_potgr (c_one, c_one, (cmplx (p*p - m**2, m*w, &
kind=default) * pr_grav(p,m,w,ueps(m,p,1))))), 0, &
"g.pr.ueps ( 1)", passed)
call expect (abs(f_potgr (c_one, c_one, (cmplx (p*p - m**2, m*w, &
kind=default) * pr_grav(p,m,w,ueps(m,p,-1))))), 0, &
"g.pr.ueps (-1)", passed)
call expect (abs(f_potgr (c_one, c_one, (cmplx (p*p - m**2, m*w, &
kind=default) * pr_grav(p,m,w,ueps(m,p,-2))))), 0, &
"g.pr.ueps (-2)", passed)
call expect (abs(f_potgr (c_one, c_one, (cmplx (p*p - m**2, m*w, &
kind=default) * pr_grav(p,m,w,veps(m,p,2))))), 0, &
"g.pr.veps ( 2)", passed)
call expect (abs(f_potgr (c_one, c_one, (cmplx (p*p - m**2, m*w, &
kind=default) * pr_grav(p,m,w,veps(m,p,1))))), 0, &
"g.pr.veps ( 1)", passed)
call expect (abs(f_potgr (c_one, c_one, (cmplx (p*p - m**2, m*w, &
kind=default) * pr_grav(p,m,w,veps(m,p,-1))))), 0, &
"g.pr.veps (-1)", passed)
call expect (abs(f_potgr (c_one, c_one, (cmplx (p*p - m**2, m*w, &
kind=default) * pr_grav(p,m,w,veps(m,p,-2))))), 0, &
"g.pr.veps (-2)", passed)
@
<<[[omega_bundle.f90]]>>=
<<[[omega_vectors.f90]]>>
<<[[omega_spinors.f90]]>>
<<[[omega_bispinors.f90]]>>
<<[[omega_vectorspinors.f90]]>>
<<[[omega_polarizations.f90]]>>
<<[[omega_tensors.f90]]>>
<<[[omega_tensor_polarizations.f90]]>>
<<[[omega_couplings.f90]]>>
<<[[omega_spinor_couplings.f90]]>>
<<[[omega_bispinor_couplings.f90]]>>
<<[[omega_vspinor_polarizations.f90]]>>
<<[[omega_utils.f90]]>>
<<[[omega95.f90]]>>
<<[[omega95_bispinors.f90]]>>
<<[[omega_parameters.f90]]>>
<<[[omega_parameters_madgraph.f90]]>>
@
<<[[omega_bundle_whizard.f90]]>>=
<<[[omega_bundle.f90]]>>
<<[[omega_parameters_whizard.f90]]>>
@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{O'Mega Virtual Machine}
<<[[omegavm95.f90]]>>=
<<Copyleft>>
module omegavm95
use kinds
use omega95
! use omega95_bispinors
implicit none
private
<<OVM Procedure Declarations>>
<<OVM Data Declarations>>
<<OVM Instructions>>
contains
<<OVM Procedure Implementations>>
end module omegavm95
@
\subsection{Memory Layout}
On one hand, we need a memory pool for all the intermediate results
<<OVM Data Declarations>>=
type, public :: ovm
private
complex(kind=default) :: amp
type(momentum), dimension(:), pointer :: p
complex(kind=default), dimension(:), pointer :: phi
type(spinor), dimension(:), pointer :: psi
type(conjspinor), dimension(:), pointer :: psibar
! type(bispinor), dimension(:), pointer :: chi
type(vector), dimension(:), pointer :: v
end type ovm
@
<<OVM Procedure Declarations>>=
public :: alloc
@
<<OVM Procedure Implementations>>=
subroutine alloc (vm, momenta, scalars, spinors, conjspinors, vectors)
type(ovm), intent(inout) :: vm
integer, intent(in) :: momenta, scalars, spinors, conjspinors, vectors
allocate (vm%p(momenta))
allocate (vm%phi(scalars))
allocate (vm%psi(spinors))
allocate (vm%psibar(conjspinors))
allocate (vm%v(vectors))
end subroutine alloc
@ and on the other hand, we need to access coupling parameters that
define the environment
<<OVM Data Declarations>>=
type, public :: ovm_env
private
real(kind=default), dimension(:), pointer :: gr
real(kind=default), dimension(:,:), pointer :: gr2
complex(kind=default), dimension(:), pointer :: gc
complex(kind=default), dimension(:,:), pointer :: gc2
end type ovm_env
@ NB: during, execution, the type of the coupling constant is implicit
in the instruction.
\begin{dubious}
How to load coupling constants? Is brute force linear lookup good
enough?
\end{dubious}
@ \subsection{Instruction Set}
<<OVM Data Declarations>>=
integer, parameter, private :: MAX_RHS = 3
type, public :: instr
private
integer :: code, sign, coupl, lhs
integer, dimension(MAX_RHS) :: rhs
end type instr
@
<<OVM Procedure Declarations>>=
public :: eval
@
<<OVM Procedure Implementations>>=
pure subroutine eval (vm, amp, env, amplitude, p, s)
type(ovm), intent(inout) :: vm
complex(kind=default), intent(out) :: amp
type(ovm_env), intent(in) :: env
type(instr), dimension(:), intent(in) :: amplitude
real(kind=default), dimension(0:,:), intent(in) :: p
integer, dimension(:), intent(in) :: s
integer :: code, sign, coupl, lhs
integer, dimension(MAX_RHS) :: rhs
integer :: i, pc
vm%p(1) = - p(:,1)
vm%p(2) = - p(:,2)
do i = 3, size (p, dim = 2)
vm%p(i) = p(:,i)
end do
do pc = 1, size (amplitude)
code = amplitude(pc)%code
sign = amplitude(pc)%sign
coupl = amplitude(pc)%coupl
lhs = amplitude(pc)%lhs
rhs = amplitude(pc)%rhs
select case (code)
<<[[case]]s of [[code]]>>
end select
end do
amp = vm%amp
end subroutine eval
@ \subsubsection{Loading External states}
<<OVM Instructions>>=
integer, public, parameter :: OVM_LOAD_SCALAR = 1
integer, public, parameter :: OVM_LOAD_U = 2
integer, public, parameter :: OVM_LOAD_UBAR = 3
integer, public, parameter :: OVM_LOAD_V = 4
integer, public, parameter :: OVM_LOAD_VBAR = 5
integer, public, parameter :: OVM_LOAD_VECTOR = 6
@
<<[[case]]s of [[code]]>>=
case (OVM_LOAD_SCALAR)
vm%phi(lhs) = 1
case (OVM_LOAD_U)
if (lhs <= 2) then
vm%psi(lhs) = u (env%gr(coupl), - vm%p(rhs(1)), s(rhs(2)))
else
vm%psi(lhs) = u (env%gr(coupl), vm%p(rhs(1)), s(rhs(2)))
end if
case (OVM_LOAD_UBAR)
if (lhs <= 2) then
vm%psibar(lhs) = ubar (env%gr(coupl), - vm%p(rhs(1)), s(rhs(2)))
else
vm%psibar(lhs) = ubar (env%gr(coupl), vm%p(rhs(1)), s(rhs(2)))
end if
case (OVM_LOAD_V)
if (lhs <= 2) then
vm%psi(lhs) = v (env%gr(coupl), - vm%p(rhs(1)), s(rhs(2)))
else
vm%psi(lhs) = v (env%gr(coupl), vm%p(rhs(1)), s(rhs(2)))
end if
case (OVM_LOAD_VBAR)
if (lhs <= 2) then
vm%psibar(lhs) = vbar (env%gr(coupl), - vm%p(rhs(1)), s(rhs(2)))
else
vm%psibar(lhs) = vbar (env%gr(coupl), vm%p(rhs(1)), s(rhs(2)))
end if
case (OVM_LOAD_VECTOR)
if (lhs <= 2) then
vm%v(lhs) = eps (env%gr(coupl), - vm%p(rhs(1)), s(rhs(2)))
else
vm%v(lhs) = eps (env%gr(coupl), vm%p(rhs(1)), s(rhs(2)))
end if
@
<<OVM Instructions>>=
integer, public, parameter :: OVM_ADD_MOMENTA = 10
@
<<[[case]]s of [[code]]>>=
case (OVM_ADD_MOMENTA)
vm%p(lhs) = vm%p(rhs(1)) + vm%p(rhs(2))
@
<<OVM Instructions>>=
integer, public, parameter :: OVM_PROPAGATE_SCALAR = 11
integer, public, parameter :: OVM_PROPAGATE_SPINOR = 12
@
<<[[case]]s of [[code]]>>=
case (OVM_PROPAGATE_SCALAR)
vm%phi(lhs) = pr_phi (vm%p(lhs),env%gr(rhs(1)),env%gr(rhs(2)),vm%phi(lhs))
case (OVM_PROPAGATE_SPINOR)
vm%psi(lhs) = pr_psi (vm%p(lhs),env%gr(rhs(1)),env%gr(rhs(2)),vm%psi(lhs))
@
<<OVM Instructions>>=
integer, public, parameter :: OVM_FUSE_VECTOR_PSIBAR_PSI = 21
integer, public, parameter :: OVM_FUSE_PSI_VECTOR_PSI = 22
integer, public, parameter :: OVM_FUSE_PSIBAR_PSIBAR_VECTOR = 23
@
<<[[case]]s of [[code]]>>=
case (OVM_FUSE_VECTOR_PSIBAR_PSI)
vm%v(lhs) = &
v_ff (sign*env%gc(coupl), vm%psibar(rhs(1)), vm%psi(rhs(2)))
case (OVM_FUSE_PSI_VECTOR_PSI)
vm%psi(lhs) = &
f_vf (sign*env%gc(coupl), vm%v(rhs(1)), vm%psi(rhs(2)))
case (OVM_FUSE_PSIBAR_PSIBAR_VECTOR)
vm%psibar(lhs) = &
f_fv (sign*env%gc(coupl), vm%psibar(rhs(1)), vm%v(rhs(2)))
@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
<<Copyleft>>=
! $Id$
!
! Copyright (C) 1999-2009 by
! Wolfgang Kilian <kilian@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.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Local Variables:
% mode:noweb
% noweb-doc-mode:latex-mode
% noweb-code-mode:f90-mode
% indent-tabs-mode:nil
% page-delimiter:"^@ %%%.*\n"
% End:

File Metadata

Mime Type
text/x-diff
Expires
Tue, Nov 19, 2:50 PM (1 d, 11 h)
Storage Engine
blob
Storage Format
Raw Data
Storage Handle
3804830
Default Alt Text
(848 KB)

Event Timeline