No OneTemporary
Actions

Size

437 KB

Subscribers

None

View Options

This file is larger than 256 KB, so syntax highlighting was skipped.

	Index: branches/bach/release_2.1.1_hoppet_top_features/share/models/SM.mdl
	===================================================================
	--- branches/bach/release_2.1.1_hoppet_top_features/share/models/SM.mdl (revision 4950)
	+++ branches/bach/release_2.1.1_hoppet_top_features/share/models/SM.mdl (revision 4951)
	@@ -1,242 +1,245 @@
	########################################################################
	# Standard Model with trivial CKM matrix
	model "SM"

	# Independent parameters
	### DO NOT CHANGE THE ORDER OF THESE PARAMETERS
	parameter GF = 1.16639E-5 # Fermi constant
	parameter mZ = 91.1882 # Z-boson mass
	parameter mW = 80.419 # W-boson mass
	parameter mH = 125 # Higgs mass
	parameter alphas = 0.1178 # Strong coupling constant (Z point)
	parameter me = 0.000510997 # electron mass
	parameter mmu = 0.105658389 # muon mass
	parameter mtau = 1.77705 # tau-lepton mass
	parameter ms = 0.095 # s-quark mass
	parameter mc = 1.2 # c-quark mass
	parameter mb = 4.2 # b-quark mass
	parameter mtop = 173.1 # t-quark mass
	parameter wtop = 1.523 # t-quark width
	parameter wZ = 2.443 # Z-boson width
	parameter wW = 2.049 # W-boson width
	parameter wH = 0.004143 # Higgs width
	parameter khgaz = 0.000 # anomaly Higgs couplings K factors
	parameter khgaga = 0.000 # anomaly Higgs couplings K factors
	parameter khgg = 0.000 # anomaly Higgs couplings K factors
	parameter xi0 = 0.000 # R_xi parameter for Z-boson
	parameter xipm = 0.000 # R_xi parameter for W-boson

	+# ILC ttbar threshold correction
	+parameter ttbar_ILC_threshold = -1 # set to positive to enable
	+
	# Dependent parameters
	derived v = 1 / sqrt (sqrt (2.) * GF) # v (Higgs vev)
	derived cw = mW / mZ # cos(theta-W)
	derived sw = sqrt (1-cw**2) # sin(theta-W)
	derived ee = 2 * sw * mW / v # em-coupling (GF scheme)
	derived alpha_em_i = 4 * pi / ee**2 # inverse fine structure const

	########################################################################
	# Particle content

	# The quarks
	particle D_QUARK 1 parton
	spin 1/2 charge -1/3 isospin -1/2 color 3
	name d down
	anti dbar D "d~"
	tex_anti "\bar{d}"
	particle U_QUARK 2 parton
	spin 1/2 charge 2/3 isospin 1/2 color 3
	name u up
	anti ubar U "u~"
	tex_anti "\bar{u}"
	particle S_QUARK 3 like D_QUARK
	name s strange
	anti sbar S "s~"
	tex_anti "\bar{s}"
	mass ms
	particle C_QUARK 4 like U_QUARK
	name c charm
	anti cbar C "c~"
	tex_anti "\bar{c}"
	mass mc
	particle B_QUARK 5 like D_QUARK
	name b bottom
	anti bbar B "b~"
	tex_anti "\bar{b}"
	mass mb
	particle T_QUARK 6 like U_QUARK
	name t top
	anti tbar T "t~"
	tex_anti "\bar{t}"
	mass mtop width wtop

	# The leptons
	particle E_LEPTON 11
	spin 1/2 charge -1 isospin -1/2
	name "e-" e1 electron e
	anti "e+" E1 positron
	tex_name "e^-"
	tex_anti "e^+"
	mass me
	particle E_NEUTRINO 12 left
	spin 1/2 isospin 1/2
	name nue n1 "nu_e" ve "e-neutrino"
	anti nuebar N1 "ve~"
	tex_name "\nu_e"
	tex_anti "\bar\nu_e"
	particle MU_LEPTON 13 like E_LEPTON
	name "mu-" e2 mu muon
	anti "mu+" E2
	tex_name "\mu^-"
	tex_anti "\mu^+"
	mass mmu
	particle MU_NEUTRINO 14 like E_NEUTRINO
	name numu "nu_mu" n2 vm "mu-neutrino"
	anti numubar N2 "vm~"
	tex_name "\nu_\mu"
	tex_anti "\bar\nu_\mu"
	particle TAU_LEPTON 15 like E_LEPTON
	name "tau-" e3 tau "ta-" tauon
	anti "tau+" E3 "ta+"
	tex_name "\tau^-"
	tex_anti "\tau^+"
	mass mtau
	particle TAU_NEUTRINO 16 like E_NEUTRINO
	name nutau "nu_tau" n3 vt "tau_neutrino"
	anti nutaubar N3 "vt~"
	tex_name "\nu_\tau"
	tex_anti "\bar\nu_\tau"

	# The vector bosons
	particle GLUON 21 parton gauge
	spin 1 color 8
	name gl g G gluon
	particle PHOTON 22 gauge
	spin 1
	name A gamma photon
	tex_name "\gamma"
	particle Z_BOSON 23 gauge
	spin 1
	name Z
	mass mZ width wZ
	particle W_BOSON 24 gauge
	spin 1 charge 1
	name "W+" Wp
	anti "W-" Wm
	tex_name "W^+"
	tex_anti "W^-"
	mass mW width wW

	# The Higgs
	particle HIGGS 25
	spin 0
	name H h Higgs
	mass mH width wH

	# Hadrons
	particle PROTON 2212
	spin 1/2 charge 1
	name p "p+"
	anti pbar "p-"

	particle HADRON_REMNANT 90

	particle HADRON_REMNANT_SINGLET 91

	particle HADRON_REMNANT_TRIPLET 92
	color 3

	particle HADRON_REMNANT_OCTET 93
	color 8

	########################################################################
	# Vertices of the Standard model
	# In graphs with identical structure the first vertex is kept for phase space
	# therefore, lighter particles come before heavier ones.

	# QED
	vertex D d A
	vertex U u A
	vertex S s A
	vertex C c A
	vertex B b A
	vertex T t A

	vertex E1 e1 A
	vertex E2 e2 A
	vertex E3 e3 A

	# QCD
	vertex G G G
	vertex G G G G

	vertex D d G
	vertex U u G
	vertex S s G
	vertex C c G
	vertex B b G
	vertex T t G

	# Neutral currents
	vertex D d Z
	vertex U u Z
	vertex S s Z
	vertex C c Z
	vertex B b Z
	vertex T t Z

	vertex E1 e1 Z
	vertex E2 e2 Z
	vertex E3 e3 Z
	vertex N1 n1 Z
	vertex N2 n2 Z
	vertex N3 n3 Z


	# Charged currents
	vertex U d Wp
	vertex C s Wp
	vertex T b Wp
	vertex D u Wm
	vertex S c Wm
	vertex B t Wm

	vertex N1 e1 Wp
	vertex N2 e2 Wp
	vertex N3 e3 Wp
	vertex E1 n1 Wm
	vertex E2 n2 Wm
	vertex E3 n3 Wm

	# Yukawa
	### keeping only 3rd generation for the moment
	# vertex S s H
	# vertex C c H
	vertex B b H
	vertex T t H
	# vertex E2 e2 H
	vertex E3 e3 H

	# Vector-boson self-interactions
	vertex Wp Wm A
	vertex Wp Wm Z

	vertex Wp Wm Z Z
	vertex Wp Wp Wm Wm
	vertex Wp Wm Z A
	vertex Wp Wm A A


	# Higgs - vector boson
	#vertex H Z A
	#vertex H A A
	#vertex H g g

	vertex H Wp Wm
	vertex H Z Z
	vertex H H Wp Wm
	vertex H H Z Z

	# Higgs self-interactions
	vertex H H H
	vertex H H H H


	Index: branches/bach/release_2.1.1_hoppet_top_features/src/models/parameters.SM.f90
	===================================================================
	--- branches/bach/release_2.1.1_hoppet_top_features/src/models/parameters.SM.f90 (revision 4950)
	+++ branches/bach/release_2.1.1_hoppet_top_features/src/models/parameters.SM.f90 (revision 4951)
	@@ -1,182 +1,225 @@
	! $Id: parameters.SM.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
	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
	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
	+ logical, public :: ilc_tt_flag = .false.

	- public :: import_from_whizard, model_update_alpha_s
	+ public :: import_from_whizard, model_update_alpha_s, &
	+ nlo_tt_fudge, va_ilc_tta, va_ilc_ttz

	contains

	subroutine import_from_whizard (par_array)
	- real(default), dimension(25), intent(in) :: par_array
	+ real(default), dimension(26), 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) :: khgaz
	real(default) :: khgaga
	real(default) :: khgg
	real(default) :: xi0
	real(default) :: xipm
	+ real(default) :: ilc_tt
	real(default) :: v
	real(default) :: cw
	real(default) :: sw
	real(default) :: ee
	end type parameter_set
	type(parameter_set) :: par
	!!! This corresponds to 1/alpha = 137.03598949333
	real(default), parameter :: &
	alpha = 1.0_default/137.03598949333_default
	e_em = sqrt(4.0_default * PI * alpha)
	par%gf = par_array(1)
	par%mZ = par_array(2)
	par%mW = par_array(3)
	par%mH = par_array(4)
	par%alphas = par_array(5)
	par%me = par_array(6)
	par%mmu = par_array(7)
	par%mtau = par_array(8)
	par%ms = par_array(9)
	par%mc = par_array(10)
	par%mb = par_array(11)
	par%mtop = par_array(12)
	par%wtop = par_array(13)
	par%wZ = par_array(14)
	par%wW = par_array(15)
	par%wH = par_array(16)
	par%khgaz = par_array(17)
	par%khgaga = par_array(18)
	par%khgg = par_array(19)
	par%xi0 = par_array(20)
	par%xipm = par_array(21)
	- par%v = par_array(22)
	- par%cw = par_array(23)
	- par%sw = par_array(24)
	- par%ee = par_array(25)
	+ par%ilc_tt = par_array(22)
	+ par%v = par_array(23)
	+ par%cw = par_array(24)
	+ par%sw = par_array(25)
	+ par%ee = par_array(26)
	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
	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 = g2 / 2.0_default / costhw2
	ghtt = - mass(6) / vev
	ghbb = - mass(5) / vev
	ghcc = - mass(4) / vev
	ghtautau = - mass(15) / vev
	ghmm = - mass(13) / vev
	gh3 = - 3 * mass(25)**2 / vev
	gh4 = - 3 * mass(25)2 / vev2
	!!! Color flow basis, divide by sqrt(2)
	gs = sqrt(2.0_defaultPIpar%alphas)
	- igs = cmplx (0.0_default, 1.0_default, kind=default) * gs
	+ igs = cmplx (0.0_default, 1.0_default, kind=default) * gs
	+ if ( par%ilc_tt > 0. ) then
	+ ilc_tt_flag = .true.
	+ end if
	end subroutine import_from_whizard

	subroutine model_update_alpha_s (alpha_s)
	real(default), intent(in) :: alpha_s
	gs = sqrt(2.0_defaultPIalpha_s)
	igs = cmplx (0.0_default, 1.0_default, kind=default) * gs
	end subroutine model_update_alpha_s
	+
	+ pure function nlo_tt_fudge(k2, i) result (c)
	+ complex(default) :: c
	+ real(default), intent(in) :: k2
	+ integer, intent(in) :: i
	+ c = 0.0_default
	+ if ( ilc_tt_flag .and. k2 > 4.mass(23)*2 ) then
	+ select case (i)
	+ case (1)
	+ !!! vector current fudge function:
	+ c = exp( -( (sqrt(k2)-2mass(6)+2.) / 4.0_default )*2 )
	+ case (2)
	+ !!! axial current fudge function:
	+ c = exp( -( (sqrt(k2)-2mass(6)+2.) / 4.0_default )*2 )
	+ end select
	+ end if
	+ end function nlo_tt_fudge
	+
	+ pure function va_ilc_tta(k2, i) result (c)
	+ complex(default) :: c
	+ real(default), intent(in) :: k2
	+ integer, intent(in) :: i
	+ if (i.eq.1) then
	+ c = qup * nlo_tt_fudge(k2,1)
	+ else
	+ c = 0.0_default
	+ end if
	+ end function va_ilc_tta
	+
	+ pure function va_ilc_ttz(k2, i) result (c)
	+ complex(default) :: c
	+ real(default), intent(in) :: k2
	+ integer, intent(in) :: i
	+ c = gncup(i) * nlo_tt_fudge(k2,i)
	+ end function va_ilc_ttz
	+
	end module parameters_sm
	Index: branches/bach/release_2.1.1_hoppet_top_features/src/omega/src/coupling.mli
	===================================================================
	--- branches/bach/release_2.1.1_hoppet_top_features/src/omega/src/coupling.mli (revision 4950)
	+++ branches/bach/release_2.1.1_hoppet_top_features/src/omega/src/coupling.mli (revision 4951)
	@@ -1,2557 +1,2557 @@
	(* $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_Scalar \| 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
	+ \| SP \| SPM \| S \| P \| SL \| SR \| SLR \| VA \| V \| A \| VL \| VR \| VLR \| VLRM \| VAM
	\| 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 (* %
	$(\ii\partial_\nu\phi) (\ii\partial_\mu V_1^\nu) V_2^\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: branches/bach/release_2.1.1_hoppet_top_features/src/omega/src/targets.ml
	===================================================================
	--- branches/bach/release_2.1.1_hoppet_top_features/src/omega/src/targets.ml (revision 4950)
	+++ branches/bach/release_2.1.1_hoppet_top_features/src/omega/src/targets.ml (revision 4951)
	@@ -1,4087 +1,4089 @@
	(* $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, VAM, Psi -> print_fermion_current_mom1 coeff "va"
	\| 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, VAM, 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 -> printf "(%s)((%s%s)(-(%s+%s)%s) - (%s%s)(-(%s+%s)*%s))"
	c p1 wf2 p1 p2 wf1 wf1 wf2 p1 p2 p1
	\| F32 -> printf "(%s)((%s%s)(-(%s+%s)%s) - (%s%s)(-(%s+%s)*%s))"
	c p2 wf1 p2 p1 wf2 wf2 wf1 p2 p1 p2
	\| 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 p2 p1 wf1
	\| F13 -> printf "(%s)%s((-((%s+%s)%s))%s - (-(%s+%s)%s)%s)"
	c wf1 p2 p1 wf2 p1 p1 p2 p1 wf2
	\| F31 -> printf "(%s)%s((-((%s+%s)%s))%s - (-(%s+%s)%s)%s)"
	c wf2 p1 p2 wf1 p2 p2 p1 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_Scalar \| 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_Scalar \| 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-%s2) (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 - %s2, %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: branches/bach/release_2.1.1_hoppet_top_features/src/omega/src/modellib_SM.ml
	===================================================================
	--- branches/bach/release_2.1.1_hoppet_top_features/src/omega/src/modellib_SM.ml (revision 4950)
	+++ branches/bach/release_2.1.1_hoppet_top_features/src/omega/src/modellib_SM.ml (revision 4951)
	@@ -1,3113 +1,3122 @@
	(* $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 \|
	S1LL \| S1RR \| S1LR \| S1RL \| S8LL \| S8RR \| QQ38

	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 intintintboolf_aux_top (i lorentzcolorchargetop-sideflavor )
	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);
	(S1LL,0,0,3); (S1RR,0,0,3); (S1LR,0,0,3); (S1RL,0,0,3);
	(S8LL,0,1,3); (S8RR,0,1,3); (QQ38,1,1,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
	+ \| VA_ILC_ttA \| VA_ILC_ttZ
	\| 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
	\| C_S1RR_bt \| C_S1RR_tb \| C_S1LL_bt \| C_S1LL_tb
	\| C_S1RL_bt \| C_S1RL_tb \| C_S1LR_bt \| C_S1LR_tb
	\| C_S8RR_bt \| C_S8RR_tb \| C_S8LL_bt \| C_S8LL_tb
	\| C_qq38
	\| 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 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;
	(O H, G Wm, G Wp), 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
	[]

	+ let ilc_nlo_ttA =
	+ [ ((M (U (-3)), G Ga, M (U 3)), FBF (1, Psibar, VAM, Psi), VA_ILC_ttA) ]
	+
	(* \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
	[]

	+ let ilc_nlo_ttZ =
	+ [ ((M (U (-3)), G Z, M (U 3)), FBF (1, Psibar, VAM, Psi), VA_ILC_ttZ) ]
	+
	(* \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 anomalous_top_quqd1_tq =
	[ ((M (D (-3)), O (Aux_top (0,0,-1,true,S1RR)), M (U 3)), FBF (1, Psibar, SR, Psi), C_S1RR_bt);
	((M (U (-3)), O (Aux_top (0,0, 1,true,S1RR)), M (D 3)), FBF (1, Psibar, SL, Psi), C_S1RR_tb);
	((M (D (-3)), O (Aux_top (0,0,-1,true,S1LL)), M (U 3)), FBF (1, Psibar, SL, Psi), C_S1LL_bt);
	((M (U (-3)), O (Aux_top (0,0, 1,true,S1LL)), M (D 3)), FBF (1, Psibar, SR, Psi), C_S1LL_tb);
	((M (D (-3)), O (Aux_top (0,0,-1,true,S1RL)), M (U 3)), FBF (1, Psibar, SR, Psi), C_S1RL_bt);
	((M (U (-3)), O (Aux_top (0,0, 1,true,S1RL)), M (D 3)), FBF (1, Psibar, SL, Psi), C_S1RL_tb);
	((M (D (-3)), O (Aux_top (0,0,-1,true,S1LR)), M (U 3)), FBF (1, Psibar, SL, Psi), C_S1LR_bt);
	((M (U (-3)), O (Aux_top (0,0, 1,true,S1LR)), M (D 3)), FBF (1, Psibar, SR, Psi), C_S1LR_tb) ]

	let anomalous_top_quqd1_ff n =
	List.map mom
	[ ((U (-n), Aux_top (0,0, 1,false,S1RR), D n), FBF (1, Psibar, SR, Psi), Half);
	((D (-n), Aux_top (0,0,-1,false,S1RR), U n), FBF (1, Psibar, SL, Psi), Half);
	((U (-n), Aux_top (0,0, 1,false,S1LL), D n), FBF (1, Psibar, SL, Psi), Half);
	((D (-n), Aux_top (0,0,-1,false,S1LL), U n), FBF (1, Psibar, SR, Psi), Half);
	((U (-n), Aux_top (0,0, 1,false,S1RL), D n), FBF (1, Psibar, SL, Psi), Half);
	((D (-n), Aux_top (0,0,-1,false,S1RL), U n), FBF (1, Psibar, SR, Psi), Half);
	((U (-n), Aux_top (0,0, 1,false,S1LR), D n), FBF (1, Psibar, SR, Psi), Half);
	((D (-n), Aux_top (0,0,-1,false,S1LR), U n), FBF (1, Psibar, SL, Psi), Half) ]

	let anomalous_top_quqd1 =
	if Flags.top_anom_4f then
	anomalous_top_quqd1_tq @ ThoList.flatmap anomalous_top_quqd1_ff [1;2;3]
	else
	[]

	let anomalous_top_quqd8_tq =
	[ ((M (D (-3)), O (Aux_top (0,1,-1,true,S8RR)), M (U 3)), FBF (1, Psibar, SR, Psi), C_S8RR_bt);
	((M (U (-3)), O (Aux_top (0,1, 1,true,S8RR)), M (D 3)), FBF (1, Psibar, SL, Psi), C_S8RR_tb);
	((M (D (-3)), O (Aux_top (0,1,-1,true,S8LL)), M (U 3)), FBF (1, Psibar, SL, Psi), C_S8LL_bt);
	((M (U (-3)), O (Aux_top (0,1, 1,true,S8LL)), M (D 3)), FBF (1, Psibar, SR, Psi), C_S8LL_tb) ]

	let anomalous_top_quqd8_ff n =
	List.map mom
	[ ((U (-n), Aux_top (0,1, 1,false,S8RR), D n), FBF (1, Psibar, SR, Psi), Half);
	((D (-n), Aux_top (0,1,-1,false,S8RR), U n), FBF (1, Psibar, SL, Psi), Half);
	((U (-n), Aux_top (0,1, 1,false,S8LL), D n), FBF (1, Psibar, SL, Psi), Half);
	((D (-n), Aux_top (0,1,-1,false,S8LL), U n), FBF (1, Psibar, SR, Psi), Half) ]

	let anomalous_top_quqd8 =
	if Flags.top_anom_4f then
	anomalous_top_quqd8_tq @ ThoList.flatmap anomalous_top_quqd8_ff [1;2;3]
	else
	[]

	let anomalous_top_qq38_tq =
	[ ((M (D (-3)), O (Aux_top (1,1,-1,true,QQ38)), M (U 3)), FBF (1, Psibar, VL, Psi), C_qq38);
	((M (U (-3)), O (Aux_top (1,1,1,true,QQ38)), M (D 3)), FBF (1, Psibar, VL, Psi), C_qq38) ]

	let anomalous_top_qq38_ff n =
	List.map mom
	[ ((D (-n), Aux_top (1,1,-1,false,QQ38), U n), FBF (1, Psibar, VL, Psi), Half);
	((U (-n), Aux_top (1,1,1,false,QQ38), D n), FBF (1, Psibar, VL, Psi), Half) ]

	let anomalous_top_qq38 =
	if Flags.top_anom_4f then
	anomalous_top_qq38_tq @ ThoList.flatmap anomalous_top_qq38_ff [1;2;3]
	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 @
	+ ilc_nlo_ttA @ ilc_nlo_ttZ @
	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 @
	anomalous_top_quqd1 @ anomalous_top_quqd8 @
	anomalous_top_qq38)

	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))
	\| "Aux_t_S1LL+" -> O (Aux_top (0,0, 1,true,S1LL)) \| "Aux_S1LL+" -> O (Aux_top (0,0, 1,false,S1LL))
	\| "Aux_t_S1LL-" -> O (Aux_top (0,0,-1,true,S1LL)) \| "Aux_S1LL-" -> O (Aux_top (0,0,-1,false,S1LL))
	\| "Aux_t_S1RR+" -> O (Aux_top (0,0, 1,true,S1RR)) \| "Aux_S1RR+" -> O (Aux_top (0,0, 1,false,S1RR))
	\| "Aux_t_S1RR-" -> O (Aux_top (0,0,-1,true,S1RR)) \| "Aux_S1RR-" -> O (Aux_top (0,0,-1,false,S1RR))
	\| "Aux_t_S1LR+" -> O (Aux_top (0,0, 1,true,S1LR)) \| "Aux_S1LR+" -> O (Aux_top (0,0, 1,false,S1LR))
	\| "Aux_t_S1LR-" -> O (Aux_top (0,0,-1,true,S1LR)) \| "Aux_S1LR-" -> O (Aux_top (0,0,-1,false,S1LR))
	\| "Aux_t_S1RL+" -> O (Aux_top (0,0, 1,true,S1RL)) \| "Aux_S1RL+" -> O (Aux_top (0,0, 1,false,S1RL))
	\| "Aux_t_S1RL-" -> O (Aux_top (0,0,-1,true,S1RL)) \| "Aux_S1RL-" -> O (Aux_top (0,0,-1,false,S1RL))
	\| "Aux_t_S8LL+" -> O (Aux_top (0,1, 1,true,S8LL)) \| "Aux_S8LL+" -> O (Aux_top (0,1, 1,false,S8LL))
	\| "Aux_t_S8LL-" -> O (Aux_top (0,1,-1,true,S8LL)) \| "Aux_S8LL-" -> O (Aux_top (0,1,-1,false,S8LL))
	\| "Aux_t_S8RR+" -> O (Aux_top (0,1, 1,true,S8RR)) \| "Aux_S8RR+" -> O (Aux_top (0,1, 1,false,S8RR))
	\| "Aux_t_S8RR-" -> O (Aux_top (0,1,-1,true,S8RR)) \| "Aux_S8RR-" -> O (Aux_top (0,1,-1,false,S8RR))
	\| "Aux_t_qq38+" -> O (Aux_top (1,1, 1,true,QQ38)) \| "Aux_qq38+" -> O (Aux_top (1,1, 1,false,QQ38))
	\| "Aux_t_qq38-" -> O (Aux_top (1,1,-1,true,QQ38)) \| "Aux_qq38-" -> O (Aux_top (1,1,-1,false,QQ38))
	\| _ -> 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"
	\| S1LL -> "S1LL" \| S1RR -> "S1RR"
	\| S1LR -> "S1LR" \| S1RL -> "S1RL"
	\| S8LL -> "S8LL" \| S8RR -> "S8RR"
	\| QQ38 -> "qq38"
	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"
	\| S1LL -> "S1LL" \| S1RR -> "S1RR"
	\| S1LR -> "S1LR" \| S1RL -> "S1RL"
	\| S8LL -> "S8LL" \| S8RR -> "S8RR"
	\| QQ38 -> "qq38"
	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"
	\| S1LL -> "s1ll" \| S1RR -> "s1rr"
	\| S1LR -> "s1lr" \| S1RL -> "s1rl"
	\| S8LL -> "s8ll" \| S8RR -> "s8rr"
	\| QQ38 -> "qq38"
	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 (_,_,ch,t,f) -> let n =
	begin match f with
	\| QW -> 0
	\| S1RR -> 1 \| S1LL -> 2
	\| S1RL -> 6 \| S1LR -> 7
	\| S8RR -> 3 \| S8LL -> 4
	\| QQ38 -> 5
	\| _ -> 8
	end
	in (602 + 3n - ch) ( if t then (1) else (-1) )
	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"
	+ \| VA_ILC_ttA -> "va_ilc_tta" \| VA_ILC_ttZ -> "va_ilc_ttz"
	\| 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"
	\| C_S1RR_bt -> "c_quqd1_1" \| C_S1RR_tb -> "conjg(c_quqd1_1)"
	\| C_S1LL_bt -> "conjg(c_quqd1_2)" \| C_S1LL_tb -> "c_quqd1_2"
	\| C_S1RL_bt -> "c_qu1" \| C_S1RL_tb -> "conjg(c_qu1)"
	\| C_S1LR_bt -> "conjg(c_qd1)" \| C_S1LR_tb -> "c_qd1"
	\| C_S8RR_bt -> "c_quqd8_1" \| C_S8RR_tb -> "conjg(c_quqd8_1)"
	\| C_S8LL_bt -> "conjg(c_quqd8_2)" \| C_S8LL_tb -> "c_quqd8_2"
	\| C_qq38 -> "c_qq38"
	\| 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: branches/bach/release_2.1.1_hoppet_top_features/src/omega/tests/parameters_SM.f90
	===================================================================
	--- branches/bach/release_2.1.1_hoppet_top_features/src/omega/tests/parameters_SM.f90 (revision 4950)
	+++ branches/bach/release_2.1.1_hoppet_top_features/src/omega/tests/parameters_SM.f90 (revision 4951)
	@@ -1,153 +1,168 @@
	! $Id: parameters.QED.omega.f90,v 1.1 2004/03/11 04:21:17 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
	use kinds
	use constants

	implicit none
	private

	real(default), dimension(27), public :: mass, width
	real(default), public :: as
	complex(default), public :: gs, igs, ig, unit

	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, &
	! ghgaga, ghgaz, ghgg, ghmm, &
	iqw, igzww, igwww, gw4, gzzww, gazww, gaaww
	real(default), public :: vev
	complex(default), dimension(2), public :: &
	gncneu, gnclep, gncup, gncdwn

	- public :: init_parameters, model_update_alpha_s
	+ public :: init_parameters, model_update_alpha_s, &
	+ va_ilc_tta, va_ilc_ttz

	real(default), parameter :: &
	GF = 1.16639E-5_default ! Fermi constant
	!!! This corresponds to 1/alpha = 137.03598949333
	real(default), parameter :: &
	alpha = 1.0_default/137.03598949333_default
	complex(default), parameter :: &
	alphas = 0.1178_default ! Strong coupling constant (Z point)

	contains

	subroutine init_parameters

	mass(1:27) = 0
	width(1:27) = 0
	mass(3) = 0.095_default ! s-quark mass
	mass(4) = 1.2_default ! c-quark mass
	! mass(5) = 4.2_default ! b-quark mass
	! mass(6) = 173.1_default ! t-quark mass
	! width(6) = 1.523_default ! t-quark width
	! mass(11) = 0.000510997_default ! electron mass
	mass(13) = 0.105658389_default ! muon mass
	mass(15) = 1.77705_default ! tau-lepton mas
	! mass(23) = 91.1882_default ! Z-boson mass
	! width(23) = 2.443_default ! Z-boson width
	! mass(24) = 80.419_default ! W-boson mass
	! width(24) = 2.049_default ! W-boson width
	mass(25) = 200._default ! Higgs mass
	width(25) = 1.419_default ! Higgs width

	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

	e_em = sqrt(4.0_default * PI * alpha)
	vev = 1 / sqrt (sqrt (2.0_default) * GF) ! v (Higgs vev)
	! costhw = mass(24) / mass(23) ! cos(theta-W)
	costhw = 0.881901_default
	sinthw = sqrt (1.0_default-costhw**2) ! sin(theta-W)
	sin2thw = sinthw**2
	tanthw = sinthw/costhw
	! e = 2.0_default * sinthw * mass(24) / vev ! em-coupling (GF scheme)
	e = 0.349196_default
	qelep = - 1
	qeup = 2.0_default / 3.0_default
	qedwn = - 1.0_default / 3.0_default
	g = e / sinthw
	ig = cmplx (0.0_default, 1.0_default, kind=default) * g
	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 = g2 / 2.0_default / costhw2
	ghtt = - mass(6) / vev
	ghbb = - mass(5) / vev
	ghcc = - mass(4) / vev
	ghtautau = - mass(15) / vev
	ghmm = - mass(13) / vev
	gh3 = - 3 * mass(25)**2 / vev
	gh4 = - 3 * mass(25)2 / vev2
	!!! Color flow basis, divide by sqrt(2)
	gs = sqrt(2.0_defaultPIalphas)
	igs = cmplx (0.0_default, 1.0_default, kind=default) * gs

	unit = 1.0_default

	end subroutine init_parameters

	subroutine model_update_alpha_s (alpha_s)
	real(default), intent(in) :: alpha_s
	gs = sqrt(2.0_defaultPIalpha_s)
	igs = cmplx (0.0_default, 1.0_default, kind=default) * gs
	end subroutine model_update_alpha_s

	+ pure function va_ilc_tta(k2, i) result (c)
	+ complex(default) :: c
	+ real(default), intent(in) :: k2
	+ integer, intent(in) :: i
	+ c = 0.0_default
	+ end function va_ilc_tta
	+
	+ pure function va_ilc_ttz(k2, i) result (c)
	+ complex(default) :: c
	+ real(default), intent(in) :: k2
	+ integer, intent(in) :: i
	+ c = 0.0_default
	+ end function va_ilc_ttz
	+
	end module parameters_sm

File Metadata

Mime Type: text/x-diff
Expires: Tue, Nov 19, 6:10 PM (1 d, 17 h)
Storage Engine: blob
Storage Format: Raw Data
Storage Handle: 3805527
Default Alt Text: (437 KB)

No OneTemporaryActions

View Options

File Metadata

Event Timeline

No OneTemporary
Actions